Re: [Haskell-cafe] Beginner: IORef constructor?

2006-12-01 Thread TJ

Thanks. I've been reading the docs and examples on State (in
Control.Monad.State), but I can't understand it at all. ticks and
plusOnes... All they seem to do is return their argument plus 1...

On 12/1/06, Bernie Pope [EMAIL PROTECTED] wrote:


On 01/12/2006, at 6:08 PM, TJ wrote:

 First of all, sorry if this is a really silly question, but I couldn't
 figure it out from experimenting in GHCi and from the GHC libraries
 documentation (or Google).

 Is there an IORef consturctor? Or is it just internal to the
 Data.IORef module?

 I want a global variable, so I did the following:

 --
 module VirtualWorld where
  import Data.IORef
  theWorld = IORef [] -- This will be writeIORef'ed with a populated
 list as the user modifies the world.
 -

 It doesn't work. GHCi says that the IORef constructor is not in scope.
 I did a :module Data.IORef and then IORef [] and it still gives me
 the same error.

 I'm using GHC 6.6 on Windows.

Hi TJ,

IORef is an abstract data type, so you cannot refer to its
constructors directly.

Instead you must use:

newIORef :: a - IO (IORef a)

which will create an IORef on your behalf. Note that the result is in
the IO type,
which limits what you can do with it.

If you want a global variable then you can use something like:

import System.IO.Unsafe (unsafePerformIO)

global = unsafePerformIO (newIORef [])

But this is often regarded as bad programming style (depends who you
talk to). So you
should probably avoid this unless it is really necessary (perhaps you
could use a state
monad instead?)

Read the comments about unsafePerformIO on this page:

http://www.haskell.org/ghc/docs/latest/html/libraries/base/System-
IO-Unsafe.html

especially the notes about NOINLINE and -fno-cse

Cheers,
Bernie.


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


Re: [Haskell-cafe] Beginner: IORef constructor?

2006-12-01 Thread Donald Bruce Stewart
tjay.dreaming:
 Thanks. I've been reading the docs and examples on State (in
 Control.Monad.State), but I can't understand it at all. ticks and
 plusOnes... All they seem to do is return their argument plus 1...

Here's a little demo. (I agree, the State docs could have nicer demos)

Play around with the code, read the haddocks, and it should make sense
eventually :)_

-- Don


import Control.Monad.State

--
-- the type for a 'global' 'variable'
--
data T = T { ref :: Int }

-- Run code with a single global 'ref', initialised to 0
main = evalStateT g $ T { ref = 0 }

-- set it to 10
g = do
printio g
putRef 10
printio modified state
f

-- read that ref, print it
f = do
r - getRef
printio r
return ()

getRef = gets ref

putRef x = modify $ \_ - T { ref = x }

printio :: Show a = a - StateT T IO ()
printio = liftIO . print
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] ANNOUNCE: Visual Haskell prerelease0.2

2006-12-01 Thread Bayley, Alistair
 From: Krasimir Angelov [mailto:[EMAIL PROTECTED] 
 
 Visual Haskell is packaged with just the core libraries.
 Control.Monad.* modules are part of mtl and Test.HUnit is part of
 HUnit which aren't core libraries and aren't installed. It was long
 time ago when I was using the official Windows installer for last
 time. Is it still packaged with all libraries?
 
 Krasimir


It certainly is. Is it possible to configure VisualHaskell so that it
uses the existing ghc-6.6 installation, rather than it's own?

Or is there some way I can copy over the HS*.o, libHS*.a, and libHS*_p.a
files and register them? Comparing the installations indicates that
ghc-6.6 has the following packages, which Visual Haskell lacks (I'm just
comparing the HS*.o files in c:\ghc\ghc-6.6 and C:\Program Files\Visual
Haskell):

cgi
fgl
GLUT (and GLUT_cbits)
haskell-src
html
HUnit
mtl
network
objectio
OpenGL (and OpenGL_cbits)
QuickCheck
readline
time
xhtml


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] Re: [Haskell] ANNOUNCE: Visual Haskell prerelease 0.2

2006-12-01 Thread shelarcy
Hi Krasimir,

On Fri, 01 Dec 2006 16:56:02 +0900, Krasimir Angelov [EMAIL PROTECTED] wrote:
 http://www.cygwin.com/ml/cygwin/1998-04/msg00133.html

 I wonder whether this may cause the problem. I have uploaded a new
 vs_haskell.dll here:

 http://www.haskell.org/visualhaskell/vs_haskell.zip

 It is the same dll but without stripped debug symbols. Could you try
 to replace it in your installation?

I tried to replace vs_haskell.dll after Windows Installer (MSI),
no error occur during devenv.exe /Setup command or using
Visual Haskell.

I can make new Haskell project.

 On Fri, 01 Dec 2006 03:48:49 +0900, Justin Bailey [EMAIL PROTECTED] wrote:
  I am having similar problems with the Visual Haskell install, and the
  commands given did not help. When I open Visual Studios Help | About 
  dialog,
  I get an error about the package failing to initialize. I am installing to
  an English copy, however.

And I can open Studios Help | About dialog without any error.

After exit Visual Haskell, Microsoft Development Environment opened
error dialog about devenv.dll sometimes. Anyway, this error is
harmless and I reported to Microsoft by form.

Best Regards,

-- 
shelarcy shelarcycapella.freemail.ne.jp
http://page.freett.com/shelarcy/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ANNOUNCE: Visual Haskell prerelease0.2

2006-12-01 Thread shelarcy
Hi Alistair,

On Fri, 01 Dec 2006 18:13:45 +0900, Bayley, Alistair [EMAIL PROTECTED] wrote:
 It certainly is. Is it possible to configure VisualHaskell so that it
 uses the existing ghc-6.6 installation, rather than it's own?

I think you can install extra libraries by cabal (and
sometime you also need MSYS and MSYS Developer Tool Kit
(autotools) for configuration).

 cgi
 fgl
 GLUT (and GLUT_cbits)
 haskell-src
 html
 HUnit
 mtl
 network
 objectio
 OpenGL (and OpenGL_cbits)
 QuickCheck
 readline
 time
 xhtml

And I proposed to bundle OpenAL and ALUT packages.

http://www.haskell.org/pipermail/glasgow-haskell-users/2006-October/011283.html

These packages are in extra libraries. And I think that -
OpenAL library is LGPL and OpenAL package is BSD3, so
there is no reason avoiding to include this package.

OpenAL site notices that OpenAL can become Creative's
licese when using on Creative Device.

http://www.openal.org/platforms.html

But if you look at Creative's OpenAL SDK header files, you
can find al.h and eft.h are LGPL. So I think we can use
OpenAL library under LGPL on Windows, if we don't use
Creative specific extentions.

http://opensource.creative.com/pipermail/openal/2004-March/007309.html

Best Reagrds,

-- 
shelarcy shelarcycapella.freemail.ne.jp
http://page.freett.com/shelarcy/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell prerelease 0.2

2006-12-01 Thread Krasimir Angelov

Thanks. In the mail that I mentioned there was a sugesstion to use -s
option during dll linking. This has the advantage that the produced
dll will be smaller but still correct. I will try to build a new dll
again with this option this time. If it works I will prepare a new
installer with the updated dll.

Cheers,
  Krasimir

On 12/1/06, shelarcy [EMAIL PROTECTED] wrote:

Hi Krasimir,

On Fri, 01 Dec 2006 16:56:02 +0900, Krasimir Angelov [EMAIL PROTECTED] wrote:
 http://www.cygwin.com/ml/cygwin/1998-04/msg00133.html

 I wonder whether this may cause the problem. I have uploaded a new
 vs_haskell.dll here:

 http://www.haskell.org/visualhaskell/vs_haskell.zip

 It is the same dll but without stripped debug symbols. Could you try
 to replace it in your installation?

I tried to replace vs_haskell.dll after Windows Installer (MSI),
no error occur during devenv.exe /Setup command or using
Visual Haskell.

I can make new Haskell project.

 On Fri, 01 Dec 2006 03:48:49 +0900, Justin Bailey [EMAIL PROTECTED] wrote:
  I am having similar problems with the Visual Haskell install, and the
  commands given did not help. When I open Visual Studios Help | About 
dialog,
  I get an error about the package failing to initialize. I am installing to
  an English copy, however.

And I can open Studios Help | About dialog without any error.

After exit Visual Haskell, Microsoft Development Environment opened
error dialog about devenv.dll sometimes. Anyway, this error is
harmless and I reported to Microsoft by form.

Best Regards,

--
shelarcy shelarcycapella.freemail.ne.jp
http://page.freett.com/shelarcy/


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


Re: [Haskell-cafe] ANNOUNCE: Visual Haskell prerelease0.2

2006-12-01 Thread Krasimir Angelov

I will build these libraries for the final installer.

On 12/1/06, shelarcy [EMAIL PROTECTED] wrote:

Hi Alistair,

On Fri, 01 Dec 2006 18:13:45 +0900, Bayley, Alistair [EMAIL PROTECTED] wrote:
 It certainly is. Is it possible to configure VisualHaskell so that it
 uses the existing ghc-6.6 installation, rather than it's own?

I think you can install extra libraries by cabal (and
sometime you also need MSYS and MSYS Developer Tool Kit
(autotools) for configuration).

 cgi
 fgl
 GLUT (and GLUT_cbits)
 haskell-src
 html
 HUnit
 mtl
 network
 objectio
 OpenGL (and OpenGL_cbits)
 QuickCheck
 readline
 time
 xhtml

And I proposed to bundle OpenAL and ALUT packages.

http://www.haskell.org/pipermail/glasgow-haskell-users/2006-October/011283.html

These packages are in extra libraries. And I think that -
OpenAL library is LGPL and OpenAL package is BSD3, so
there is no reason avoiding to include this package.

OpenAL site notices that OpenAL can become Creative's
licese when using on Creative Device.

http://www.openal.org/platforms.html

But if you look at Creative's OpenAL SDK header files, you
can find al.h and eft.h are LGPL. So I think we can use
OpenAL library under LGPL on Windows, if we don't use
Creative specific extentions.

http://opensource.creative.com/pipermail/openal/2004-March/007309.html

Best Reagrds,

--
shelarcy shelarcycapella.freemail.ne.jp
http://page.freett.com/shelarcy/
___
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] Beginner: IORef constructor?

2006-12-01 Thread TJ

Thanks for the demo. I don't actually understand what's going on yet,
but your code doesn't  really use a global variable, does it? From
what I can understand, the main function is passing the State to the
other functions.

I think I was careless about mixing IO functions and normal
functions. Now that I think about it, my global variable really
should only be available to IO functions, so the following should be
just fine:

--
module Global where

import Data.IORef

theGlobalVariable = newIORef []

testIt = do ref - theGlobalVariable
   original - readIORef ref
   print original
   writeIORef ref [1,2,3]
   new - readIORef ref
   print new
--

I've got a lot to learn about Haskell...

On 12/1/06, Donald Bruce Stewart [EMAIL PROTECTED] wrote:

tjay.dreaming:
 Thanks. I've been reading the docs and examples on State (in
 Control.Monad.State), but I can't understand it at all. ticks and
 plusOnes... All they seem to do is return their argument plus 1...

Here's a little demo. (I agree, the State docs could have nicer demos)

Play around with the code, read the haddocks, and it should make sense
eventually :)_

-- Don


import Control.Monad.State

--
-- the type for a 'global' 'variable'
--
data T = T { ref :: Int }

-- Run code with a single global 'ref', initialised to 0
main = evalStateT g $ T { ref = 0 }

-- set it to 10
g = do
printio g
putRef 10
printio modified state
f

-- read that ref, print it
f = do
r - getRef
printio r
return ()

getRef = gets ref

putRef x = modify $ \_ - T { ref = x }

printio :: Show a = a - StateT T IO ()
printio = liftIO . print


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


Re: [Haskell-cafe] Beginner: IORef constructor?

2006-12-01 Thread Donald Bruce Stewart
tjay.dreaming:
 Thanks for the demo. I don't actually understand what's going on yet,
 but your code doesn't  really use a global variable, does it? From
 what I can understand, the main function is passing the State to the
 other functions.

Right, via the monad. The monad does all the threading.

 
 I think I was careless about mixing IO functions and normal
 functions. Now that I think about it, my global variable really
 should only be available to IO functions, so the following should be
 just fine:
 
 --
 module Global where
 
 import Data.IORef
 
 theGlobalVariable = newIORef []
 
 testIt = do ref - theGlobalVariable
original - readIORef ref
print original
writeIORef ref [1,2,3]
new - readIORef ref
print new
 --
 
 I've got a lot to learn about Haskell...

Now, if you wanted to pass that ref to other functions, you'd have to
thread it explicitly -- unless you store it in a state monad :)

i.e. do ref - theGlobalVariable
...
.. f ref
...

  f r = do  
...
.. g r
...

I kind of jumped ahead that step, and went straight to the implicitly
threaded version. 

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


Re[2]: [Haskell-cafe] How to get subset of a list?

2006-12-01 Thread Bulat Ziganshin
Hello Huazhi,

Friday, December 1, 2006, 5:04:10 AM, you wrote:

 However, like I want to choose s[1,3,6,10] or something like this. Are there
 some straightforward function or operator for doing this job? The !!
 operator in haskell seems does not support multiple indecies.

just change your mind, Neo ;)

Hugs map (abcdefg !!) [1,3,6]
bdg :: [Char]


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] Beginner: IORef constructor?

2006-12-01 Thread Donald Bruce Stewart
tjay.dreaming:
 Donald:
 Now, if you wanted to pass that ref to other functions, you'd have to
 thread it explicitly -- unless you store it in a state monad :)
 
 i.e. do ref - theGlobalVariable
 ...
 .. f ref
 ...
 
   f r = do
 ...
 .. g r
 ...
 
 I kind of jumped ahead that step, and went straight to the implicitly
 threaded version.
 
 -- Don
 
 
 Tested my code again and it doesn't work as expected. I don't
 understand what threading means, but is that the reason I can't have
 this:
 
 --
 module StateTest where
 
 import Data.IORef
 
 theGlobalVariable = newIORef []
 
 modify1 = do ref - theGlobalVariable
 original - readIORef ref
 print original
 writeIORef ref $ original ++ [1]
 new - readIORef ref
 print new
 
 modify2 = do ref - theGlobalVariable
 original - readIORef ref
 print original
 writeIORef ref $ original ++ [2]
 new - readIORef ref
 print new
 
 doIt = do modify1
  modify2

This doesn't mean what you think it means :) In particular,
theGlobalVariable isn't a global variable, its a function that creates a
new IORef, initialised to []. So you create two new iorefs, once in
modify1, and again in modify2.

For this kind of problem, I'd use a State transformer monad, layered
over IO, as follows:

import Control.Monad.State

main = evalStateT doIt []

doIt = do
modify1
modify2

modify1 = do
orig - get
printio orig
put (1 : orig)
new  - get
printio new

modify2 = do
orig - get
printio orig
put (2 : orig)
new  - get
printio new

printio :: Show a = a - StateT a IO ()
printio = liftIO . print

Running this:

$ runhaskell A.hs
[]
[1]
[1]
[2,1]

Note that there's no need for any mutable variables here. If this isn't
suitable, perhaps you could elaborate a bit on what effect you're trying
to achieve?

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


Re: [Haskell-cafe] Draft MissingH Reorg Plan

2006-12-01 Thread Malcolm Wallace
John Goerzen [EMAIL PROTECTED] wrote:

 Please tell me if I should just go away or go to another list here.

How about [EMAIL PROTECTED]

   http://software.complete.org/missingh/wiki/TransitionPlanning
 
 Your comments (and edits! -- must register/login first) are welcome.

About Text.ParserCombinators.Parsec.RFC2234 and the like.  Although I
can't see what this code does (no links on the wiki, and port 70 is
firewalled here), I would be prepared to bet that you do not in fact
define any new combinators for parsing.  What you have there is a parser
for a specific little language.  Even if it is implemented using parsec
combinators, it does not belong with them.

Alternative suggestions:
Language.RFC2234.Parse
Language.ABNF.RFC2234.Parse
Network.SMTP.RFC2821.Parse
Network.Email.RFC2822.Parse

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


Re: [Haskell-cafe] Beginner: IORef constructor?

2006-12-01 Thread Udo Stenzel
TJ wrote:
 --
 module Global where
 
 import Data.IORef
 
 theGlobalVariable = newIORef []
 
 testIt = do ref - theGlobalVariable
original - readIORef ref
print original
writeIORef ref [1,2,3]
new - readIORef ref
print new
 --

Wrong.  You get a fresh new variable everytime you access
'theGlobalVariable'.  


 I've got a lot to learn about Haskell...

Well, for starters:

- there are no variables in ordinary Haskell,
- there are variables in the ST and IO monads, but dragging IO
  everywhere is burdensome and you don't want to do that,
- you can probably fake global variables using 'unsafePerformIO', and
  you definitely don't want to mess with that (yet),
- you need to understand monads in general, the State monad, the ST
  monad and the IO monad, and in exactly this order.
  
Whatever you're trying to do right now, just forget that there are
variables in BASIC and do it without mutable state.


-Udo
-- 
They laughed at Einstein.
They laughed at the Wright Brothers.
But they also laughed at Bozo the Clown.
-- attributed to Carl Sagan


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


Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell prerelease 0.2

2006-12-01 Thread Justin Bailey

On 11/30/06, Krasimir Angelov [EMAIL PROTECTED] wrote:



I wonder whether this may cause the problem. I have uploaded a new
vs_haskell.dll here:

http://www.haskell.org/visualhaskell/vs_haskell.zip

It is the same dll but without stripped debug symbols. Could you try
to replace it in your installation?



That new DLL worked for me, and I can also create new Haskell projects. Very
cool - thanks!

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


Re: [Haskell-cafe] Beginner: IORef constructor?

2006-12-01 Thread TJ

Donald:

This doesn't mean what you think it means :) In particular,
theGlobalVariable isn't a global variable, its a function that creates a
new IORef, initialised to []. So you create two new iorefs, once in
modify1, and again in modify2.


Indeed, it's not what I thought it was at all!

Bulat:

you may be interested in looking at
http://haskell.org/haskellwiki/IO_inside


Thanks for the link.

Udo:

Whatever you're trying to do right now, just forget that there are
variables in BASIC and do it without mutable state.


Alrighty. But I'd like to set the record straight that it was C++
which screwed up my mind forever ;)

Donald:

Note that there's no need for any mutable variables here. If this isn't
suitable, perhaps you could elaborate a bit on what effect you're trying
to achieve?


Yes I've come to the same conclusion. Thanks for the help, it really helps :)

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


Re: [Haskell-cafe] Re[2]: How to get subset of a list?

2006-12-01 Thread Huazhi (Hank) Gong

Good. I personally perfer this solution...


Bulat Ziganshin-2 wrote:
 
 Hello Huazhi,
 
 Friday, December 1, 2006, 5:04:10 AM, you wrote:
 
 However, like I want to choose s[1,3,6,10] or something like this. Are
 there
 some straightforward function or operator for doing this job? The !!
 operator in haskell seems does not support multiple indecies.
 
 just change your mind, Neo ;)
 
 Hugs map (abcdefg !!) [1,3,6]
 bdg :: [Char]
 
 
 -- 
 Best regards,
  Bulatmailto:[EMAIL PROTECTED]
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 

-- 
View this message in context: 
http://www.nabble.com/How-to-get-subset-of-a-list--tf2735647.html#a7637491
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell prerelease 0.2

2006-12-01 Thread Krasimir Angelov

The zip file is updated with .dll that is with stripped debug symbols
but with --optdll-s as it is recommended. Could some one try whether
it works? It is about two times smaller than the non stripped version.


  http://www.haskell.org/visualhaskell/vs_haskell.zip


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


Re: [Haskell-cafe] IFF reader and writer

2006-12-01 Thread Sven Panne
Am Freitag, 1. Dezember 2006 16:30 schrieb Henning Thielemann:
 On AmigaOS there is a library called iffparse.library, which is used for
 processing the Interchange File Format, which is a binary container format
 developed by Electronic Arts for any kind of data.
   http://en.wikipedia.org/wiki/Interchange_File_Format
 The best known instances of this format are certainly the AIFF sampled
 sound format and WAV (which is RIFF, that is little endian IFF).
  Short question: Is there some Haskell library for parsing and
 constructing files of this format?

I don't have any Haskell lib for (R)IFF, but as one of the freealut authors I 
have the pleasure to maintain a WAV reader, among other things. IMHO WAV is 
one of the most idiotic, redundant and underspecified format in the world, 
and most existing WAV files are broken in some respect. PNGs are a bit 
better, but all those chunked formats are a bit problematic in practice, 
because new chunk types are constantly being invented, contradict other 
chunks, etc. etc.

Quite a few concrete (R)IFF instances can contain (R)IFF within chunks 
themselves, furthermore you have always be prepared to handle an unknown 
chunk type. So a general (R)IFF type can't be much more than a tree with a 
tagged bunch of bytes at each node, which is not really of much help IMHO. 
Separate libraries for handling WAV, TIFF, PNG, AVI, etc. might make more 
sense, as they can reflect the underlying structure much better.

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


Re: [Haskell-cafe] IFF reader and writer

2006-12-01 Thread Henning Thielemann

On Fri, 1 Dec 2006, Sven Panne wrote:

 I don't have any Haskell lib for (R)IFF, but as one of the freealut authors I 
 have the pleasure to maintain a WAV reader, among other things. IMHO WAV is 
 one of the most idiotic, redundant and underspecified format in the world, 
 and most existing WAV files are broken in some respect. PNGs are a bit 
 better, but all those chunked formats are a bit problematic in practice, 
 because new chunk types are constantly being invented, contradict other 
 chunks, etc. etc.

The idea is that unknown chunks can be ignored in most cases. Of course,
this is not always possible, but there are several examples where it
worked.

 Quite a few concrete (R)IFF instances can contain (R)IFF within chunks 
 themselves, furthermore you have always be prepared to handle an unknown 
 chunk type. So a general (R)IFF type can't be much more than a tree with a 
 tagged bunch of bytes at each node, which is not really of much help IMHO. 

That's exactly what I ask for. Some of the features of the IFF like CAT
and PROP chunks are rarely used, maybe because there were no libraries
which support them.

 Separate libraries for handling WAV, TIFF, PNG, AVI, etc. might make more 
 sense, as they can reflect the underlying structure much better.

But they could all use a general IFF library. This way you can bundle
different kinds of data in one file, say sounds and pictures for an
animation.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] First Call for Papers: TFP 2007, New York

2006-12-01 Thread TFP 2007
CALL FOR PAPERS
Trends in Functional Programming 2007
New York, USA
April 2-4, 2007
http://cs.shu.edu/tfp2007/ 
  OR
http://tltc.shu.edu/tfp2007/
 
 
The symposium on Trends in Functional Programming (TFP) is an 
international forum for researchers with interests in all aspects of 
functional programming languages,  focusing on providing a broad view of 
current and future trends in Functional Programming. It aspires to be a 
lively environment for presenting the latest  research results through 
acceptance by extended abstracts. A formal post-symposium refereeing 
process then selects the best articles presented at the symposium for 
publication in a high-profile volume.   
 

TFP 2007 is co-hosted by Seton Hall University and The City College of New 
York (CCNY) 
and will be held in New York, USA, April 2-4, 2007 at the CCNY campus.
SCOPE OF THE SYMPOSIUM 
 
The symposium recognizes that new trends may arise through various routes. 
As part of the Symposium's focus on trends we therefore identify the 
following five article  categories. High-quality articles are solicited in 
any of these categories:
 
Research Articlesleading-edge, previously unpublished research 
work
Position Articles  on what new trends should or should not be   
Project Articles   descriptions of recently started new projects 
Evaluation Articles   what lessons can be drawn from a finished 
project
Overview Articles summarizing work with respect to a trendy 
subject
 
Articles must be original and not submitted for simultaneous publication 
to any other forum. They may consider any aspect of functional 
programming: theoretical,   implementation-oriented, or more 
experience-oriented. Applications of functional programming techniques to 
other languages are also within the scope of the symposium. 
 
Articles on the following subject areas are particularly welcomed:
 
o Dependently Typed Functional Programming   
o Validation and Verification of Functional Programs
o Debugging for Functional Languages
o Functional Programming and Security
o Functional Programming and Mobility
o Functional Programming to Animate/Prototype/Implement Systems from 
Formal or Semi-Formal Specifications 
o Functional Languages for Telecommunications Applications
o Functional Languages for Embedded Systems
o Functional Programming Applied to Global Computing
o Functional GRIDs
o Functional Programming Ideas in Imperative or Object-Oriented Settings 
(and the converse)
o Interoperability with Imperative Programming Languages
o Novel Memory Management Techniques
o Parallel/Concurrent Functional Languages
o Program Transformation Techniques   
o Empirical Performance Studies   
o Abstract/Virtual Machines and Compilers for Functional Languages   
o New Implementation Strategies
o any new emerging trend in the functional programming area
 
If you are in doubt on whether your article is within the scope of TFP, 
please contact the TFP 2007 program chair, Marco T. Morazan, at  
[EMAIL PROTECTED]
 
 
SUBMISSION AND DRAFT PROCEEDINGS
 
Acceptance of articles for presentation at the symposium is based on the 
review of extended abstracts (6 to 10 pages in length) by the program 
committee. Accepted  abstracts are to be completed to full papers before 
the symposium for publication in the draft proceedings and on-line. 
Further details can be found at the TFP 2007 website. 
 
 
POST-SYMPOSIUM REFEREEING AND PUBLICATION
 
In addition to the draft symposium proceedings, we intend to continue the 
TFP tradition of publishing a high-quality subset of contributions in the 
Intellect series on Trends in Functional Programming.  
 
IMPORTANT DATES
 
Abstract Submission: February 1, 2007
Notification of Acceptance: February 20, 2007
Registration Deadline: March 2, 2007   
Camera Ready Full Paper Due: March 9, 2007
TFP Symposium: April 2-4, 2007
 
 
PROGRAMME COMMITTEE
 
John Clements   California Polytechnic State University, 
USA   
Marko van Eekelen Radboud Universiteit Nijmegen, The 
Netherlands   
Benjamin Goldberg New York University, USA   
Kevin Hammond University of St. Andrews, UK 
Patricia Johann  Rutgers University, USA   
Hans-Wolfgang Loidl   Ludwig-Maximilians Universität München, 
Germany   
Rita Loogen   Philipps-Universität Marburg, Germany   
Greg MichaelsonHeriot-Watt University, UK   
Marco T. Morazán (Chair)Seton Hall University, USA   
Henrik NilssonUniversity of Nottingham, UK   
Chris OkasakiUnited States Military Academy at West 
Point, USA   
Rex Page  University of Oklahoma, USA   
Ricardo Pena Universidad Complutense de Madrid, Spain 
  
Benjamin C. Pierce University of Pennsylvania, USA   
John ReppyUniversity of Chicago, USA   
Ulrik P. Schultz   

Re: [Haskell-cafe] Draft MissingH Reorg Plan

2006-12-01 Thread John Goerzen
On Fri, Dec 01, 2006 at 01:56:34AM -0600, Taral wrote:
 On 12/1/06, Tomasz Zielonka [EMAIL PROTECTED] wrote:
 Do you accept contributions? I have some code I find very useful that

Yes!

 would fit in the same places, like in Text.ParserCombinators.Parsec.Utils,
 Data.BitsUtils (btw, why not Data.Bits.Utils?), Control.Concurrent.*.

Data.Bits.Utils would be fine too.  I tried not to add a new level of
hierarchy where none existed, but that may be more consistent.

 
 Hey, contributions. I'll throw in my haskell MIME parser if you want
 it. It's not the same as the one that most people use -- but I like it
 better. :)

Hey Taral -- got a URL where I could take a look at it?  MissingH
currently has the one from WASH but if you've got a better one, I would
certainly be interested.  WASH brings a ton of weight along with it, and
it would be nice to not have to carry that around.

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


Re: [Haskell-cafe] Draft MissingH Reorg Plan

2006-12-01 Thread John Goerzen
On Fri, Dec 01, 2006 at 07:04:56AM +0100, Tomasz Zielonka wrote:
http://software.complete.org/missingh/wiki/TransitionPlanning
  
  Your comments (and edits! -- must register/login first) are welcome.
 
 As for other code (say Data.Tree.Utils), I am not sure what's best: put
 it in some big library like yours, or publish as separate small
 libraries. There is more work with the latter, but it seems more clean,
 and easy to review for the user.

Well, MissingH is going the direction of splitting up into smaller
pieces, based on feedback received here, so I'd probably suggest that
you keep that separate.  Unless it's just one small/simple module.

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


[Haskell-cafe] Re: Draft MissingH Reorg Plan

2006-12-01 Thread John Goerzen
Malcolm Wallace wrote:

 John Goerzen [EMAIL PROTECTED] wrote:
 
 Please tell me if I should just go away or go to another list here.
 
 How about [EMAIL PROTECTED]

Fair enough.  Will do.

   http://software.complete.org/missingh/wiki/TransitionPlanning
 
 Your comments (and edits! -- must register/login first) are welcome.
 
 About Text.ParserCombinators.Parsec.RFC2234 and the like.  Although I
 can't see what this code does (no links on the wiki, and port 70 is
 firewalled here), I would be prepared to bet that you do not in fact
 define any new combinators for parsing.  What you have there is a parser

Here's a snippet:

This module provides parsers for the grammar defined in RFC2234, Augmented
BNF for Syntax Specifications: ABNF,
http://www.faqs.org/rfcs/rfc2234.html. The terminal called char in the RFC
is called character  here to avoid conflicts with Parsec's char function.

alpha :: CharParser st Char
bit :: CharParser st Char
character :: CharParser st Char
cr :: CharParser st Char

This one is not email-specific.  The other two are.  (BTW, they were written
by Peter Simons)

 for a specific little language.  Even if it is implemented using parsec
 combinators, it does not belong with them.
 
 Alternative suggestions:
 Language.RFC2234.Parse
 Language.ABNF.RFC2234.Parse
 Network.SMTP.RFC2821.Parse
 Network.Email.RFC2822.Parse

Does the above suggest a single good place for them to you?

-- John

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


[Haskell-cafe] Functional GUI combinators for arbitrary graphs of components?

2006-12-01 Thread Brian Hulley

Hi,
I've been looking at the Fudgets research 
(http://www.cs.chalmers.se/ComputingScience/Research/Functional/Fudgets/ ) 
as an example of a purely functional gui.


Afaiu a brief summary is that a Fudget can represent a GUI widget or some 
other object, which can have some internal state, and which receives and 
passes messages to the other Fudgets it is connected to. Fudgets are 
connected to each other by combinators eg:


   second == first-- sequential (first sends messages to second)
   a * b   -- parallel

There is a continuation passing implementation such that the messages are 
passed and internal states of Fudgets are updated (by replacing each fudget 
with an updated fudget) as these expressions are evaluated hence the message 
passing and maintenance of state doesn't involve any IORefs though 
interaction with external devices such as the OS uses IO.


Anyway to get to my point, though all this sounds great, I'm wondering how 
to construct an arbitrary graph of Fudgets just from a fixed set of 
combinators, such that each Fudget (node in the graph) is only mentioned 
once in the expression. To simplify the question, assume we have the 
following data structure to describe the desired graph:


   data LinkDesc a
   = Series a a
   | Broadcast a [a]
   | Merge [a] a

   type GraphDesc a = [LinkDesc a]

and a function to compute a combined object (eg Fudget) corresponding to an 
arbitrary graph would be:


   mkObj :: Ord label = Map label Obj - GraphDesc label - Obj
   mkObj = -- ???

The result of mkObj will be some expression, composed from a finite set of 
combinators applied to the named objects, but with the all important 
property that each named object appears no more than once in the expression 
(this is what allows Fudgets to correspond to notional objects which 
maintain internal state - during evaluation each fudget gets replaced by an 
updated fudget hence can only appear once in the whole expression).


As a very simple example using existing Fudgets combinators,

   type Map label value = [(label, value)]

   mkObj [(A, objA), (B, objB), (C, objC)]
   [Series A B, Series B C]

   ===objC == objB == objA

and

   mkObj [(A, objA), (B, objB), (C, objC)]
   [Broadcast A [B, C]]

   === (objB * objC) == objA

However:

   mkObj [(A, objA), (B, objB), (C, objC), (D, objD)]
   [Broadcast A [B, C], Series B D, Series A D]

   === ???

The Fudgets library provides many combinators eg for looping, but even so, I 
don't think there are sufficient combinators to express the above graph 
(though possibly extra nodes and tagging/untagging would solve this 
example), or more heavily connected graphs such as:


   [Series A B, Series B C, Series C D, Series D B, 
Series C A]


This problem is so general (ie converting a cyclic graph into an expression 
tree such that each node appears no more than once) that I'm sure someone 
somewhere must already have determined whether or not there can be a 
solution, though I don't know where to look or what to search for.


Any ideas?
Thanks, Brian.
--
http://www.metamilk.com 


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


Re: [Haskell-cafe] IFF reader and writer

2006-12-01 Thread Chris Kuklewicz
This parser was quick to write and works on AIFF files.  It does not do much
validation, and bits from 2 to 4 GB in length will cause errors.

module LoadIFF(IFF(..),parseIFF,IDType,FormType,ContentsType) where

import Data.List(unfoldr,span)
import Data.Bits((.|.),shiftL)
import Data.Word(Word32)
import Data.ByteString(ByteString)
import qualified Data.ByteString as B(take,drop,splitAt,length,unpack)

type IDType = String
type FormType = String
type ContentsType = String

data IFF = IFF_Form {len :: Word32
,typeID :: FormType
,parts :: [IFF]
}
 | IFF_List {len :: Word32
,typeID :: ContentsType
,props :: [IFF]
,parts :: [IFF]
}
 | IFF_Cat  {len :: Word32
,typeID :: ContentsType
,parts :: [IFF]
}
 | IFF_Prop {len :: Word32
,typeID :: FormType
,parts :: [IFF]
}
 | IFF_Chunk {len :: Word32
 ,typeID :: IDType
 ,rawContent :: ByteString
 }

instance Show IFF where
  show IFF_Form { typeID = name, len = size, parts = p } =
IFF_Form {typeID=++show name++,size=++show size++,parts=++show p++}
  show IFF_List { typeID = name, len = size, props = ps, parts = p } =
IFF_List {typeID=++show name++,size=++show size++,props++show
ps++,parts=++show p++}
  show IFF_Cat { typeID = name, len = size, parts = p } =
IFF_Cat {typeID=++show name++,size=++show size++,parts=++show p++}
  show IFF_Prop { typeID = name, len = size, parts = p } =
IFF_Prop {typeID=++show name++,size=++show size++,parts=++show p++}
  show IFF_Chunk { typeID = name, len = size } = IFF_Chunk {typeID=++show
name++,size=++show size++}

b2s = map (toEnum . fromEnum) . B.unpack

isProp IFF_Prop {} = True
isProp _ = False

parseIFF :: ByteString - Maybe (IFF,ByteString)
parseIFF b | B.length b =8 = Nothing
   | otherwise =
  let (bID,b') = B.splitAt 4 b
  (bLEN,b'') = B.splitAt 4 b'
  (bTypeID,content) = B.splitAt 4 b''
  [x1,x2,x3,x4] = map fromIntegral (B.unpack bLEN)
  iLEN = (shiftL x1 24) .|. (shiftL x2 16) .|. (shiftL x3 8) .|. x4
  toNext = (if odd iLEN then succ else id) (fromIntegral iLEN)
  rest = B.drop toNext b''
  in if iLEN  fromIntegral (B.length b'')
   then Nothing
   else let iff = case b2s bID of
FORM - IFF_Form {len = iLEN
   ,typeID = b2s bTypeID
   ,parts = unfoldr parseIFF content}
LIST - let (ps,cs) = span isProp (unfoldr parseIFF
content)
  in IFF_List {len = iLEN
  ,typeID = b2s bTypeID
  ,props = ps
  ,parts = cs}
CAT  - IFF_Cat {len = iLEN
  ,typeID = b2s bTypeID
  ,parts = unfoldr parseIFF content}
Prop - IFF_Prop {len = iLEN
   ,typeID = b2s bTypeID
   ,parts = unfoldr parseIFF content}
chunkID - IFF_Chunk {len = iLEN
 ,typeID = chunkID
 ,rawContent = content}
in Just (iff,rest)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Functional GUI combinators for arbitrary graphs ofcomponents?

2006-12-01 Thread Brian Hulley

Brian Hulley wrote:

Anyway to get to my point, though all this sounds great, I'm
wondering how to construct an arbitrary graph of Fudgets just from a
fixed set of combinators, such that each Fudget (node in the graph)
is only mentioned once in the expression. To simplify the question,
assume we have the following data structure to describe the desired
graph:
   data LinkDesc a
   = Series a a
   | Broadcast a [a]
   | Merge [a] a

   type GraphDesc a = [LinkDesc a]


The above is more complicated than necessary. The problem can be captured 
by:


   type GraphDesc a = [(a,a)]

Brian.
--
http://www.metamilk.com 


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


Re: [Haskell-cafe] why are implicit types different? (cleanup)

2006-12-01 Thread John Meacham
On Tue, Nov 28, 2006 at 11:59:01AM -0500, S. Alexander Jacobson wrote:
 
 I ended up solving it by using a typeclass.  My general experience of 
 implicit types has been that they end up being a lot less useful than 
 they appear.  Getting the types right ends up being difficult and it 
 is usually better just to be in a monad or as in this case to use 
 typeclasses.  I've begun to think of use of implicit types as a sign a 
 bad smell in the code and if I have used one somewhere, I try to 
 eliminate it because doing so usually results in better code overall.

yes. they are just a bad idea for many reasons IMHO. I think they should
be purposefully and forcefully retired  so they don't trip up new users
to haskell who think they are the right way to do things.

John 

-- 
John Meacham - ⑆repetae.net⑆john⑈
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell prerelease 0.2

2006-12-01 Thread shelarcy
Hi Krasimir,

On Sat, 02 Dec 2006 02:14:26 +0900, Krasimir Angelov [EMAIL PROTECTED] wrote:
 The zip file is updated with .dll that is with stripped debug symbols
 but with --optdll-s as it is recommended. Could some one try whether
 it works? It is about two times smaller than the non stripped version.

   http://www.haskell.org/visualhaskell/vs_haskell.zip

Is this file updated one?
I downloaded it from above url again. But file size is same.
So, I checked hash. It noticed that current and previous files
are same.

$ md5sum vs_haskell.dll
\a968ac130932a9b38bd0da50e9ae865a *C:\\Documents and Settings\\
Administrator\\My Documents\\vs_haskell\\vs_haskell.dll

$ md5sum C:\Doc\Haskell\vs_haskell\vs_haskell.dll
\a968ac130932a9b38bd0da50e9ae865a *C:\\Doc\\Haskell\\vs_haskell\\
vs_haskell.dll

Best Regards,

-- 
shelarcy shelarcycapella.freemail.ne.jp
http://page.freett.com/shelarcy/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Parsec: Where's +++?

2006-12-01 Thread Greg Fitzgerald

Koen Claessen's Parallel Parsing Processes, suggests their parsing
combinators have been integrated into Parsec.  If so, where is the +++
operator hiding?

If not, does anyone know of a parsing library with a choice operator
that does breadth-first search?

Also, how do I determine what instances a datatype supports?  Is
Parsec an instance of Applicative?

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


Re: [Haskell-cafe] Parsec: Where's +++?

2006-12-01 Thread Donald Bruce Stewart
garious:
 Koen Claessen's Parallel Parsing Processes, suggests their parsing
 combinators have been integrated into Parsec.  If so, where is the +++
 operator hiding?

Hoogle says:

Control.Arrow.(+++) :: ArrowChoice a = a b c - a b' c' - a (Either b b') 
(Either c c')
Text.Html.(+++) :: (HTML a, HTML b) = a - b - Html
Text.ParserCombinators.ReadP.(+++) :: ReadP a - ReadP a - ReadP a
Text.ParserCombinators.ReadPrec.(+++) :: ReadPrec a - ReadPrec a - ReadPrec a
  
 Also, how do I determine what instances a datatype supports?  Is
 Parsec an instance of Applicative?

Try :info on your type in ghci:

Prelude Control.Applicative :info Applicative
class (Functor f) = Applicative f where
  pure :: a - f a
  (*) :: f (a - b) - f a - f b
-- Defined in Control.Applicative
instance (Monad m) = Applicative (WrappedMonad m)
  -- Defined in Control.Applicative
instance Applicative Maybe -- Defined in Control.Applicative
instance Applicative [] -- Defined in Control.Applicative
instance Applicative IO -- Defined in Control.Applicative
instance Applicative ((-) a) -- Defined in Control.Applicative
instance Applicative ZipList -- Defined in Control.Applicative

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


[Haskell-cafe] Command line utility that shrinks/simplifies functions applications ?

2006-12-01 Thread Jason Dagit

On 11/30/06, Pepe Iborra [EMAIL PROTECTED] wrote:



On 30/11/2006, at 17:04, Spencer Janssen wrote:


I believe you're talking about the `pl' plugin for lambdabot.  Lambdabot has
an offline mode, visit the homepage for the source:

 http://www.cse.unsw.edu.au/~dons/lambdabot.html




There is also a web interface to lambdabot, but I can't seem to find the
link.
http://lambdabot.codersbase.com/

It's really nice, I use it all the time.


Thanks, we had fun putting lambdabot on the web (I have some other
plans for it now too, but no time!).

It had been a long time since I updated that instance of lambdabot but
your email prompted me to do that today.  The instance at that url now
supports, redo, undo and unpl and has been synched with the official
version of lambdabot 4p284.

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


Re: [Haskell-cafe] Parsec: Where's +++?

2006-12-01 Thread Greg Fitzgerald

Text.ParserCombinators.ReadP.(+++) :: ReadP a - ReadP a - ReadP a


Wow, fast and complete, Thanks Don!:)

Would it make sense to derive instances of Applicable and Alternative
for ReadP?  Something like this maybe:

instance Applicative ReadP where
pure = return
(*) = ap

instance Alternative ReadP where
empty = pfail
(|) = (++)

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


[Haskell-cafe] The Data.Array.* hierarchy is unsafe (or, Segfaulting for fun and profit)

2006-12-01 Thread Spencer Janssen
I've discovered a problem in the array libraries that allows one to  
read arbitrary memory locations without the use of any unsafeFoo  
functions.  Both GHC and Hugs are affected.


 import Data.Array.IArray
 import Data.Array.Unboxed

Here is a poorly behaved instance of Ix: inRange and index ignore the  
bounds supplied.


 newtype EvilIx = E Int deriving (Eq, Ord)
 instance Ix EvilIx where
inRange _ _ = True
index _ (E i) = i
range (E x, E y) = map E $ range (x, y)

One can read arbitrary memory locations, eventually indexing far  
enough to cause a segmentation fault.


 main = print [a ! E (2^i) | i - [0..]]
  where
a :: UArray EvilIx Int
a = array (E 0, E 0) []

This problem is not specific to UArrays:

 main' = print [a ! E (2^i) | i - [0..]]
  where
a :: Array EvilIx String
a = array (E 0, E 0) []

The issue is that the array operators trust the Ix instance to manage  
boundaries correctly.  The solution is to double check the value  
returned by index with the actual length of the array.


I volunteer to write the fix, if I can extract some hints from more  
knowledgeable folk.  There's sizeOfByteArray#, is there an analog for  
an Array#?  I need to know how to find the length of Hugs array  
primitives too.



Cheers,
Spencer Janssen

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


Re: Re: [Haskell-cafe] Parsec: Where's +++?

2006-12-01 Thread Nicolas Frisby

A agreed upon technique for dealing with typeclass hierarchies has
been slow to arrive. For instance, all monads are functors, but
providing a monad instance for your type doesn't automatically make it
a functor as well.

All monads are also applicative functors, and Control.Applicative does
have a newtype to recognize them as such:

Prelude :m + Control.Applicative
Prelude Control.Applicative :i WrapMonad
newtype WrappedMonad m a = WrapMonad {unwrapMonad :: m a}
   -- Defined in Control.Applicative
Prelude Control.Applicative :i Applicative
class (Functor f) = Applicative f where
 pure :: a - f a
 (*) :: f (a - b) - f a - f b
   -- Defined in Control.Applicative
instance (Monad m) = Applicative (WrappedMonad m)
 -- Defined in Control.Applicative
...

Just wrap up your monad in WrapMonad, treat it like an applicative
functor, and then unwrap it with unwrapMonad.

HTH,
Nick

On 12/1/06, Greg Fitzgerald [EMAIL PROTECTED] wrote:

 Text.ParserCombinators.ReadP.(+++) :: ReadP a - ReadP a - ReadP a

Wow, fast and complete, Thanks Don!:)

Would it make sense to derive instances of Applicable and Alternative
for ReadP?  Something like this maybe:

instance Applicative ReadP where
pure = return
(*) = ap

instance Alternative ReadP where
empty = pfail
(|) = (++)

Thanks,
Greg
___
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] IFF reader and writer

2006-12-01 Thread Henning Thielemann

On Fri, 1 Dec 2006, Chris Kuklewicz wrote:

 This parser was quick to write and works on AIFF files.  It does not do much
 validation, and bits from 2 to 4 GB in length will cause errors.

Nice. But it doesn't handle the semantics of PROP, does it?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell prerelease 0.2

2006-12-01 Thread Krasimir Angelov

Sorry. I was sleeping and I uploaded it to darcs.haskell.org instead
to haskell.org. Try it now.

Cheers,
 Krasimir

On 12/2/06, shelarcy [EMAIL PROTECTED] wrote:

Hi Krasimir,

On Sat, 02 Dec 2006 02:14:26 +0900, Krasimir Angelov [EMAIL PROTECTED] wrote:
 The zip file is updated with .dll that is with stripped debug symbols
 but with --optdll-s as it is recommended. Could some one try whether
 it works? It is about two times smaller than the non stripped version.

   http://www.haskell.org/visualhaskell/vs_haskell.zip

Is this file updated one?
I downloaded it from above url again. But file size is same.
So, I checked hash. It noticed that current and previous files
are same.

$ md5sum vs_haskell.dll
\a968ac130932a9b38bd0da50e9ae865a *C:\\Documents and Settings\\
Administrator\\My Documents\\vs_haskell\\vs_haskell.dll

$ md5sum C:\Doc\Haskell\vs_haskell\vs_haskell.dll
\a968ac130932a9b38bd0da50e9ae865a *C:\\Doc\\Haskell\\vs_haskell\\
vs_haskell.dll

Best Regards,

--
shelarcy shelarcycapella.freemail.ne.jp
http://page.freett.com/shelarcy/


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


[Haskell-cafe] Generate 50 random coordinates

2006-12-01 Thread Huazhi (Hank) Gong

Hello,all

My intention is to generate 50 random coordinates like (x,y).

myrand :: Int
myrand = randomRIO(1::Int, 100)

rf=[(myrand, myrand) | a - [1..50]]

My short program is like this. However, GHCI say that the return type of
randomRIO is IO a while the function defined by me is Int. Since I only need
a integral type as my cooridinate, could you tell me how to fix this?

Hank
-- 
View this message in context: 
http://www.nabble.com/Generate-50-random-coordinates-tf2742242.html#a7651116
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Generate 50 random coordinates

2006-12-01 Thread Taral

On 12/2/06, Huazhi (Hank) Gong [EMAIL PROTECTED] wrote:

myrand :: Int
myrand = randomRIO(1::Int, 100)

rf=[(myrand, myrand) | a - [1..50]]


do
   let myrand = randomRIO (1 :: Int, 100)
   rf - replicateM 50 (liftM2 (,) myrand myrand)

--
Taral [EMAIL PROTECTED]
You can't prove anything.
   -- Gödel's Incompetence Theorem
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Generate 50 random coordinates

2006-12-01 Thread Donald Bruce Stewart
hankgong:
 
 Hello,all
 
 My intention is to generate 50 random coordinates like (x,y).
 
 myrand :: Int
 myrand = randomRIO(1::Int, 100)
 
 rf=[(myrand, myrand) | a - [1..50]]
 
 My short program is like this. However, GHCI say that the return type of
 randomRIO is IO a while the function defined by me is Int. Since I only need
 a integral type as my cooridinate, could you tell me how to fix this?
 

Try initialising your random generator in 'main' , creating a list of
infinite randoms, take the number you need, then feed that to the
functions that need the list:

import System.Random
import Text.Printf
import Data.Word

main = do
g - newStdGen  -- intialise a random generator
let (a,b) = split g -- create two separate generators
as = randoms a  -- one infinite list of randoms
bs = randoms b  -- another
rs = zip as bs  -- an infite list of pairs
dump (take 50 rs)   -- take 50, and consume them

dump :: [(Int,Int)] - IO ()
dump s = mapM_ (uncurry (printf (%d,%d)\n)) s

And running this:

$ runhaskell A.hs
(639240856,75173658)
(-979753698,2004752008)
(1514872498,-686799980)
(1122012756,-645055058)
...

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


Re: [Haskell-cafe] Functional GUI combinators for arbitrary graphs of components?

2006-12-01 Thread Taral

On 12/1/06, Brian Hulley [EMAIL PROTECTED] wrote:

This problem is so general (ie converting a cyclic graph into an expression
tree such that each node appears no more than once) that I'm sure someone
somewhere must already have determined whether or not there can be a
solution, though I don't know where to look or what to search for.


I suggest you check the Functional Graph Library (FGL). It's shipped
as part of GHC.

--
Taral [EMAIL PROTECTED]
You can't prove anything.
   -- Gödel's Incompetence Theorem
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell source transformer?

2006-12-01 Thread Lemmih

On 11/30/06, Dimitry Golubovsky [EMAIL PROTECTED] wrote:

Hi,

In order to automatize the creation of W3C DOM typesafe wrapper (this
is needed for my Haskell-Javascript stuff) I am processing the OMG
IDL files that contain interface definitions for DOM methods and
attributes with HDirect.

It works in general (for some reason it didn't like boolean type, so
I used a preprocessor to redefine it as Boolean), and outputs some
Haskell code full of foreign calls, yet it contains what I need: type
signatures.

For example, for the method appendChild it outputs:

appendChild :: Node a1
- Node a0
- Prelude.IO (Node ())
appendChild newChild iptr =
  do
o_appendChild - Com.invokeIt (\ methPtr iptr -
Foreign.ForeignPtr.withForeignPtr newChild (\ new
unmarshallNode o_appendChild

(above lines of code may be truncated, they are just for illustration)

This is almost it, but I need to replace the return type (using the JS
monad instead of IO), and replace the method implementation with
something else, based on unsafeJS.

In some other cases I may need to modify type declarations, etc.

I know there is a Haskell syntax parser around (maybe, more than one).
Does anybody know of any utility based on such parser that does things
I need, or rather a library on top of the parser? I just would like to
avoid reinventing the wheel.

Last thing I want to do is to change sources of HDirect.

Thanks.


There's haskell-src and haskell-src-exts (
http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/ ).

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


Re: [Haskell-cafe] Generate 50 random coordinates

2006-12-01 Thread Jason Dagit

Hello,

On 12/1/06, Huazhi (Hank) Gong [EMAIL PROTECTED] wrote:


Hello,all

My intention is to generate 50 random coordinates like (x,y).

myrand :: Int
myrand = randomRIO(1::Int, 100)


When we look at the type of randomRIO we see:
randomRIO :: forall a. (Random a) = (a, a) - IO a

You're giving it a tuple of Int, so we can substitute Int for 'a' in
that type signature:
myrand :: IO Int



rf=[(myrand, myrand) | a - [1..50]]


Here you are creating a list of tuples.  We see from above that the
type of the tuples would be (IO Int, IO Int), so rf :: [(IO Int, IO
Int)].  This is because we have not run the IO action to generate the
Int yet.


My short program is like this. However, GHCI say that the return type of
randomRIO is IO a while the function defined by me is Int. Since I only need
a integral type as my cooridinate, could you tell me how to fix this?


Your type signature tries to make a claim that myrand has type Int,
but the compiler will disagree because of that pesky IO type.

Yet Another Haskell Tutorial[1] seems to have a section on the pesky IO type.

[1] http://www.cs.utah.edu/~hal/docs/daume02yaht.pdf

I hope that helps,
Jason
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe