Re: [Haskell-cafe] List manipulation

2005-01-27 Thread Jules Bean
On 27 Jan 2005, at 07:32, Sven Panne wrote:
Jules Bean wrote:
[...] You rather want 'zipWith'.  Documentation at:
http://www.haskell.org/ghc/docs/latest/html/libraries/base/ 
GHC.List.html
...along with lots of other funky list processing stuff.
Just a small hint: Everything below GHC in the hierarchical libraries
is, well, GHC-specific, meant for internal use only and may change  
without
further notice, see Stability: internal in the page you mentioned.  
Just
use  
http://haskell.org/ghc/docs/latest/html/libraries/base/Data.List.html
instead.

Ah yes, apologies for misleading. That's what I get for bashing in a  
google search and copy-pasting the first URL I find instead of starting  
from the hierarchical libraries home page and looking for the right  
page :P

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


Re: [Haskell-cafe] Problem with Hyperlinking Haddock-documentation

2005-01-27 Thread Daniel Fischer
Am Mittwoch, 26. Januar 2005 21:49 schrieben Sie:
 On Wed, 26 Jan 2005, Daniel Fischer wrote:
  Maybe somebody can enlighten me.
 
  When I run haddock and put the html files e.g. in directory ~/bar/foo,
  any references to things defined in the Prelude or the libraries are
  linked to, say ~/bar/foo/Prelude.html#t%3AFractional, which of course
  does not exist, because the documentation for the Prelude is elsewhere.
 
  How can I tell haddock to link such references to where Prelude.html
  actually is?

 I add an option like

 -i /usr/local/share/ghc-6.2/html/libraries/base/base.haddock

The problem still stands, the link is to ~/bar/foo/Prelude.html,
not to /usr/local/
where Prelude.html is.

Does anybody know what to do?

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Keean Schupke
Ben Rudiak-Gould wrote:
I'm tentatively opposed to (B), since I think that the only 
interesting difference between Win32 and Posix paths is in the set of 
starting points you can name. (The path separator isn't very 
interesting.) But maybe it does make sense to have separate 
starting-point ADTs for each operating system. Then of course there's 
the issue that Win32 edge labels are Unicode, while Posix edge labels 
are [Word8]. Hmm.

Several assumptions here... We might want more platforms than 
windows/unix. The separator for these systems is different (\ for 
windows / for unix - who knows what other obscure systems may use).

It seems to me a type class would allow the user to add definitions for 
their platform (IE it is extensible)... datatypes tend to be hard to 
extend as you have to find every use in the code
and modify it.

For code to be portable it has to use a diffenernt path parser depending 
on the platform, but
the code must not be different... One way of doing this would be to use 
a class...

   data Windows
   data Unix
   type System = Unix
   class ParsePath a where
  parsePath' :: a - String - Path
   instance ParsePath Windows where
  parsePath' _ a = ...
   instance ParsePath Unix where
  parsePath' _ a = ...
If all paths can be expressed in a single type, it seems different path 
parsers and printers are required. All the other functions could operate 
on the standard datatype. This still leaves the
problem of determining what system you are compiling on... I guess I 
still don't see the problem with having:

   #ifdef Unix
  type System = Unix
   #endif
   #ifdef Windows
  type System = Windows
   #endif
In some library somewhere... Infact its the only way I can see of 
selecting the correct
instance at compile time... and using classes is the only way I can 
think of making the
system easily extensible (even if we use a single datatype for all paths)

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


[Haskell-cafe] Question on case x of g when g is a function

2005-01-27 Thread yeoh
Can a kind soul please enlighten me on why f bit0 and f bit1 
both return 0?

 bit0 = False
 bit1 = True
 f x = case x of
 bit0 - 0
 bit1 - 1

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


Re: [Haskell-cafe] Question on case x of g when g is a function

2005-01-27 Thread Salvador Lucas
Because both bit0 and bit1 are free *local* variables
within the case expression. So, they have nothing
to do with your defined functions bit0 and bit1.
Best regards,
Salvador.
[EMAIL PROTECTED] wrote:
Can a kind soul please enlighten me on why f bit0 and f bit1 
both return 0?

 

bit0 = False
bit1 = True
f x = case x of
   bit0 - 0
   bit1 - 1
   

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

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


[Haskell-cafe] Re: library documentation

2005-01-27 Thread Peter Simons
Isaac Jones writes:

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

This is a great idea.

I have been thinking  you know what would make
contribution to the library efforts even simpler? If they
were available in a Darcs repository.

Saying darcs push after you've spontaneously added a
three-line explanation into a standard library is a lot more
attractive than cvs diff, cutting and pasting that diff
into an editor, and e-mailing it to the -libraries list.
(Who submits a diff for three lines of documentation?)

One of the reasons why Darcs is great is that it makes
submitting changes very simple for _everybody_.

Peter

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread David Roundy
On Wed, Jan 26, 2005 at 10:20:12PM -0500, Robert Dockins wrote:
 class (Show p) = Path p where
   isAbsolute :: p - Bool
   isRelative  :: p - Bool
   isRelative = not . isAbsolute
   basename :: p - String
   parent :: p - p
   pathAppend :: p - p - p
   pathExtend :: p - String - p
   pathSeparator :: p - Char
   pathParser :: Parser p  
   parsePath :: String - p
   parsePath x = 
  case parse pathParser  x of
Left e  - error $ show e
Right x - x

Warning: I'm not interested in a path parsing/combining library, so my
criticisms are perhaps unrelated to your goals.

One thing that I'd be interested in seeing for any Path class would be a
simple instance for FilePath (or String, if you want to imagine FilePath
will be changed).  Not everyone will want the overhead of a massively
heavyweight Path datatype.  I'd actually rather have something
lighter-weight than String (think PackedString), since FilePaths can take
up a good chunk of darcs' memory.

Another thing to consider is that any Path class *needs* to have a
conversion to C string (probably of the with variety).  Even on Windows,
where apparently a FilePath is not a sequence of bytes, we'd like to be
able to use the FFI to call the C standard library, and it would be nice to
be able to access the same file both via the FFI and also via the haskell
standard libraries.  Of course, this means we'd want a similar conversion
the other way.

I guess it's just that I'm more concerned with making possible what is
currently impossible (according to the library standards)--that is, using
FFI and IO on the same file--rather than just adding utility features that
application developers could have written themselves.  I suppose we don't
need a class for this, all we need is a couple of functions to convert
between FilePath and CString.
-- 
David Roundy
http://www.darcs.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Keean Schupke

I guess it's just that I'm more concerned with making possible what is
currently impossible (according to the library standards)--that is, using
FFI and IO on the same file--rather than just adding utility features that
application developers could have written themselves.  I suppose we don't
need a class for this, all we need is a couple of functions to convert
between FilePath and CString.
 

Except paths are different on different platforms... for example:
/a/b/../c/hello\ there/test
and:
A:\a\b\
notice how the backslash is used to 'escape' a space or meta-character on
unix, but is the path separator for windows. If you want to write portable
applications, then you dont want to hard code the platform type. So 
converting
from the datatype to a string is not simple:

   string = pathToString ...
one way of doing this is to have pathToString call a function to 
determine the
system type and construct the string accordingly. The problem here is 
that it is
not extensible by the user, the supported platforms are determined by 
the library.
By using a class we can let the user define translations for new 
platforms...

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


[Haskell-cafe] Re: Answers to Exercises in Craft of FP

2005-01-27 Thread Henning Thielemann

On Wed, 26 Jan 2005, Christian Hofer wrote:

 who have to learn the interesting stuff completely on our own, because
 bad luck supplies us only with Java teachers (although other professors
 use Scheme, Lisp, Prolog)

That's my experience, too!

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


Re: [Haskell-cafe] Question on case x of g when g is a function

2005-01-27 Thread Henning Thielemann

On Thu, 27 Jan 2005 [EMAIL PROTECTED] wrote:

 Can a kind soul please enlighten me on why f bit0 and f bit1
 both return 0?

  bit0 = False
  bit1 = True
  f x = case x of
  bit0 - 0
  bit1 - 1

If you compile with 'ghc -Wall' GHC should report that the identifier
'bit0' in the case expression shadows the global 'bit0' identifier. What
you want to do is:

f x = if x == bit0 then 0 else 1

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Jules Bean
On 27 Jan 2005, at 11:33, Keean Schupke wrote:
Except paths are different on different platforms... for example:
/a/b/../c/hello\ there/test
and:
A:\a\b\
notice how the backslash is used to 'escape' a space or meta-character 
on

only it isn't. That's a property of a shell, the underlying OS allows 
spaces in file names with no need for an escaping mechanism.

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


[Haskell-cafe] Convert to unboxed value? How?

2005-01-27 Thread Dimitry Golubovsky
Hi,
What function should be used to convert an integer value to Int#?
A character to Char#?
Dimitry Golubovsky
Middletown, CT
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Problem with Hyperlinking Haddock-documentation

2005-01-27 Thread Simon Marlow
On 27 January 2005 09:03, Daniel Fischer wrote:

 Am Mittwoch, 26. Januar 2005 21:49 schrieben Sie:
 On Wed, 26 Jan 2005, Daniel Fischer wrote:
 Maybe somebody can enlighten me.
 
 When I run haddock and put the html files e.g. in directory
 ~/bar/foo, any references to things defined in the Prelude or the
 libraries are linked to, say ~/bar/foo/Prelude.html#t%3AFractional,
 which of course does not exist, because the documentation for the
 Prelude is elsewhere. 
 
 How can I tell haddock to link such references to where Prelude.html
 actually is?
 
 I add an option like
 
 -i /usr/local/share/ghc-6.2/html/libraries/base/base.haddock
 
 The problem still stands, the link is to ~/bar/foo/Prelude.html,
 not to /usr/local/
 where Prelude.html is.
 
 Does anybody know what to do?

You probably want to invoke Haddock like this:

 haddock
-i/usr/share/ghc-6.2.2/html/libraries/base,/usr/share/ghc-6.2.2/librarie
s/base/base.haddock

(all on one line).  The first path specifies the directory of the HTML
for the base package, the second path specifies the .haddock file for
the base package.

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


RE: [Haskell-cafe] Re: library documentation

2005-01-27 Thread Simon Marlow
On 27 January 2005 10:46, Peter Simons wrote:

 Isaac Jones writes:
 
   http://www.haskell.org/hawiki/LibraryDocsNeedingHelp
 
 This is a great idea.
 
 I have been thinking  you know what would make
 contribution to the library efforts even simpler? If they
 were available in a Darcs repository.
 
 Saying darcs push after you've spontaneously added a
 three-line explanation into a standard library is a lot more
 attractive than cvs diff, cutting and pasting that diff
 into an editor, and e-mailing it to the -libraries list.
 (Who submits a diff for three lines of documentation?)
 
 One of the reasons why Darcs is great is that it makes
 submitting changes very simple for _everybody_.

This would be great, but unfortunately the activation energy is quite
high: we're already pretty committed to CVS, so we either move over to
darcs wholesale, or we keep GHC in CVS and libraries in darcs.  Neither
is particularly attractive right now - darcs isn't ready for projects
the size of GHC (at least, last I looked), and having a split repository
would be a nightmare.

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


Re: [Haskell-cafe] Re: library documentation

2005-01-27 Thread Arthur van Leeuwen
On Thu, Jan 27, 2005 at 12:41:27PM -, Simon Marlow wrote:
 On 27 January 2005 10:46, Peter Simons wrote:
 
  Isaac Jones writes:
  
http://www.haskell.org/hawiki/LibraryDocsNeedingHelp
  
  This is a great idea.

  I have been thinking  you know what would make
  contribution to the library efforts even simpler? If they
  were available in a Darcs repository.

  Saying darcs push after you've spontaneously added a
  three-line explanation into a standard library is a lot more
  attractive than cvs diff, cutting and pasting that diff
  into an editor, and e-mailing it to the -libraries list.
  (Who submits a diff for three lines of documentation?)

  One of the reasons why Darcs is great is that it makes
  submitting changes very simple for _everybody_.

 This would be great, but unfortunately the activation energy is quite
 high: we're already pretty committed to CVS, so we either move over to
 darcs wholesale, or we keep GHC in CVS and libraries in darcs.  Neither
 is particularly attractive right now - darcs isn't ready for projects
 the size of GHC (at least, last I looked), and having a split repository
 would be a nightmare.

However, having a darcs repository just for the docs would be better 
than having a wiki, right? That way you have a central repository
with documentation all ready to go in the format you'd need to enter
into CVS, and then once in a while, e.g. when a new GHC release is 
imminent, someone goes through the burden of going through all the
documentation submissions and incorporates those that are applicable
in the CVS tree...

The beauty of darcs, as I see it, is that a repository is basically 
a directory structure with some metadata inside it, and that 
directorystructure can just as easily *also* be under CVS...

Doei, Arthur.

-- 
  /\/ |   [EMAIL PROTECTED]   | Work like you don't need the money
 /__\  /  | A friend is someone with whom | Love like you have never been hurt
/\/__ | you can dare to be yourself   | Dance like there's nobody watching
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Looking for these libraries...

2005-01-27 Thread Marcin 'Qrczak' Kowalczyk
John Goerzen [EMAIL PROTECTED] writes:

 I'm looking for libraries / interfaces to these systems from Haskell:

 LDAP
 ncurses
 zlib  (the one in darcs doesn't suit my needs)
 bz2lib

I once wrapped ncurses (incomplete), zlib and bz2lib.
http://sourceforge.net/projects/qforeign/

It's quite old and will not compile with recent compilers without
modifications. FFI libraries were being designed at that time, it
should be possible to replace QForeign with Foreign, modulo some
changes since that time.

-- 
   __( Marcin Kowalczyk
   \__/   [EMAIL PROTECTED]
^^ http://qrnik.knm.org.pl/~qrczak/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Keean Schupke
Jules Bean wrote:
only it isn't. That's a property of a shell, the underlying OS allows 
spaces in file names with no need for an escaping mechanism.
Okay, that was a mistake... but it does not change the point, that 
pathToString needs to work out what platform it
is on, and doing it without typeclasses makes it not extensible.

We need a way of allowing people to define new path printers (as members 
of a class)... whilst having the program
determine which platform it is on, and choosing the correct instance (at 
compile time).

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread robert dockins

Warning: I'm not interested in a path parsing/combining library, so my
criticisms are perhaps unrelated to your goals.
One thing that I'd be interested in seeing for any Path class would be a
simple instance for FilePath (or String, if you want to imagine FilePath
will be changed).  Not everyone will want the overhead of a massively
heavyweight Path datatype.
I'm not convinced that this is massively heavyweight, but your criticism 
is heard.  Perhaps we should realize that there are two separate things 
going on here.  One is the ability to pass around path names as black 
boxes to the various IO routines without examining the path.  The other 
is the ability to examine and manipulate the path.  So perhaps we want 
something like this:

class PathStorage p where
   fromBytes :: Int - Ptr () - IO p
   withBytes :: p - (Ptr () - IO a) - IO a
class (Show p,PathStorage p) = Path p where
   path manipulation routines
   path parsing routines...
   etc...
Then we could have things like:
instance PathStorage (Ptr ()) where
   fromBytes  _ ptr = return ptr
   withBytes p f = f p
or
instance PathStorage (ForeignPtr ()) where
   fromBytes  _ ptr = newForeignPtr finalizerFree ptr
   withBytes p f = withForeignPtr p f
or
instance (Storable p) = PathStorage [p]
   fromBytes n ptr = peekArray n (castPtr ptr)
   withBytes p f = withArray p f
as well as the full ADT implementations.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] fastest Fibonacci numbers in the West

2005-01-27 Thread Daniel Fischer
Am Donnerstag, 27. Januar 2005 06:08 schrieb William Lee Irwin III:
 Inspired by a discussion on freenode #haskell, I tried to write the
 fastest Fibonacci number function possible, i.e. given a natural
 number input n to compute F_n.


 For the moment, mlton-generated binaries crash computing fib (10^8-1),
 and there is a 6:1 speed difference for fib (10^7-1) between the two,
 where mlton-generated binaries take just under 1 minute, and ghc-
 generated binaries take just under 6 minutes.

Obviously, your machine is significantly faster than mine.
On mine, fib (10^6) takes a little under two minutes, fib (10^7-1) I ^C-ed 
after twenty.

I think ,more readable than
unfoldl f x = case f x of
Nothing - []
Just (u, v) - unfoldl f v ++ [u]
divs 0 = Nothing
divs k = Just (uncurry (flip (,)) (k `divMod` 2))

would be
unfoldl f x = case f x of
 Nothing - []
 Just (q,r) - unfoldl f q ++ [r]
divs 0 = Nothing
divs k = Just (n `quotRem` 2)
-- this has no influence on performance, since it's optimized anyway.

 Anyway, thoughts on how to improve all this from the programmer's
 point of view, or otherwise explaining what's going on or ameliorating
 whatever effect is at work here would be appreciated.


I thought, I'd do it in the ring of integers in Q(sqrt(5)), code attached,
this was a whiff faster for n = 70 on my machine, a whiff slower 
for n = 10^6 -- any idea how that may come?

 -- wli
Danielmodule Main where

import System.Environment

infix 8 :+

data Surd5 = !Integer :+ !Integer
deriving (Eq, Show, Read)

instance Num Surd5 where
   (a :+ b) + (c :+ d) = (a+c) :+ (b+d)
   (a :+ b) - (c :+ d) = (a-c) :+ (b-d)
   (a :+ b) * (c :+ d) = (a*c+b*d) :+ (a*d+(c+d)*b)
   negate (a :+ b) = (-a) :+ (-b)
   signum (a :+ b) = case signum a of
0 - signum b :+ 0
1 - case signum b of
(-1) - signum ((2*a-b)^2-5*b^2) :+ 0
_- 1 :+ 0
_ - case signum b of
1 - signum (5*b^2-(2*a-b)^2) :+ 0
_ - (-1) :+ 0
   abs s = signum s * s
   fromInteger n = n :+ 0

fib :: Integral a = a - Integer
fib n = let (a:+b) = (0:+1)^n in b

main :: IO ()
main = getArgs = mapM_ (print . fib . read)___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: library documentation

2005-01-27 Thread Simon Marlow
On 27 January 2005 13:31, Arthur van Leeuwen wrote:

 However, having a darcs repository just for the docs would be better
 than having a wiki, right? That way you have a central repository
 with documentation all ready to go in the format you'd need to enter
 into CVS, and then once in a while, e.g. when a new GHC release is
 imminent, someone goes through the burden of going through all the
 documentation submissions and incorporates those that are applicable
 in the CVS tree...

Ah, I see.  Sure, that's a fine idea.

Cheers,
Simon

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Krasimir Angelov
Hello Guys,

Let me propose another solution which is simpler (at least from my
point of view)and will not break the existing. When I designed the API
of the original System.FilePath library I looked at OS.Path modules
from Python and ML. They both uses plain string to keep the file path
but does precise parsing/printing of the path when it is manipulated.
I haven't ever heard of any language that uses special FilePath type
instead of plain string. I don't want to do any parsing/printing each
time when I need to open file or create directory. In most cases the
file path is passed as string from the outside world to the
application and if we have special FilePath then we need each time to
parse it. What I propose is the following:

 - Keep the existing System.IO API the same. openFile, createDirectory
... will take the file path as string.
 - Introduce two new modules System.Posix.FilePath and
System.Win32.FilePath. Each of them will provide functions for
parsing/printing of paths to/from some platform specific type:
PosixFilePath and Win32FilePath. As you can see from Robert Dockins
examples, these types can be completely different.
 - Introduce third module System.FilePath which will do some basic
operations of path through parsing/printing. The API of this module
can be similar to this which I wrote but its implementation can be
more accurate if it works on some ADT instead of string. The module
will use #ifdef in order to import the right from the above two
modules.

 In most cases we do only simple manipulations on path and I don't
think it is required and easy to explicitly parse/print the path only
in order to change its extension. I prefer to invoke changeFileExt and
don't care how the function will do its job. If someone would like to
perform any more complicated operations on file path he can import the
system specific module and use PosixFilePath or Win32FilePath. This is
basically the way in which OS.Path is implemented in ML.

The type class solution doesn't work very well. As Simon said it may
require to have #ifdef-s in some places in order to choice the right
type. Another disadvantage is that this will complicate some data
types. Example:

data FilePath a = MyFileInfo a = MyFileInfo { path :: a; size :: Integer }

I don't want to add extra type parameters here only in order to
specify the right FilePath type.


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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Gregory Wright
Hello,
On Jan 27, 2005, at 10:46 AM, Krasimir Angelov wrote:
Hello Guys,
Let me propose another solution which is simpler (at least from my
point of view)and will not break the existing. When I designed the API
of the original System.FilePath library I looked at OS.Path modules
from Python and ML. They both uses plain string to keep the file path
but does precise parsing/printing of the path when it is manipulated.
I haven't ever heard of any language that uses special FilePath type
instead of plain string. I don't want to do any parsing/printing each
time when I need to open file or create directory. In most cases the
file path is passed as string from the outside world to the
application and if we have special FilePath then we need each time to
parse it. What I propose is the following:
Actually, Common Lisp specifies a special data type to handle logical
filepaths, which are distinct from file path strings.  Having had to 
debug
common lisp code that uses this (written by other people) I've observed
that this attempt to do the Right Thing almost certainly has caused
more trouble than it has solved.

While an abstract filepath isolates you from having to deal with the
syntax of file paths on different systems, it does not provide an 
abstract
view of the filesystem hierarchy.  These differ greatly, even among
unix-like systems.  Handling differences in the file system hierarchy
inevitably results in a lot of system specific code, for any program 
that
has to use files scattered across a system.


 - Keep the existing System.IO API the same. openFile, createDirectory
... will take the file path as string.
 - Introduce two new modules System.Posix.FilePath and
System.Win32.FilePath. Each of them will provide functions for
parsing/printing of paths to/from some platform specific type:
PosixFilePath and Win32FilePath. As you can see from Robert Dockins
examples, these types can be completely different.
 - Introduce third module System.FilePath which will do some basic
operations of path through parsing/printing. The API of this module
can be similar to this which I wrote but its implementation can be
more accurate if it works on some ADT instead of string. The module
will use #ifdef in order to import the right from the above two
modules.
 In most cases we do only simple manipulations on path and I don't
think it is required and easy to explicitly parse/print the path only
in order to change its extension. I prefer to invoke changeFileExt and
don't care how the function will do its job. If someone would like to
perform any more complicated operations on file path he can import the
system specific module and use PosixFilePath or Win32FilePath. This is
basically the way in which OS.Path is implemented in ML.

Your proposal above for a lightweight solution seems the right way
to go.  If there is really a need for a higher layer it could be built 
upon
something like you suggest.

One thing that the library shouldn't exclude is the manipulation
of non-native file paths.  For example, I on my unix system I may want
to generate a win32 file path as part of some code that will be executed
on Windows machine.  The underlying os-specific modules should always
be available, even if there is a module for file path manipulations 
specific
to the host-OS. (If I understand correctly, this is what you've proposed
with the System.FilePath.)


The type class solution doesn't work very well. As Simon said it may
require to have #ifdef-s in some places in order to choice the right
type. Another disadvantage is that this will complicate some data
types. Example:
data FilePath a = MyFileInfo a = MyFileInfo { path :: a; size :: 
Integer }

I don't want to add extra type parameters here only in order to
specify the right FilePath type.
Cheers,
 Krasimir
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

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


Re: [Haskell-cafe] Problem with Hyperlinking Haddock-documentation

2005-01-27 Thread Daniel Fischer
Am Donnerstag, 27. Januar 2005 13:38 schrieben Sie:

 You probably want to invoke Haddock like this:

  haddock
 -i/usr/share/ghc-6.2.2/html/libraries/base,/usr/share/ghc-6.2.2/librarie
 s/base/base.haddock

 (all on one line).  The first path specifies the directory of the HTML
 for the base package, the second path specifies the .haddock file for
 the base package.

 Cheers,
   Simon
That's it. 
Many thanks. 
Obviously I misunderstood the optionality of the path.

BTW, would it be worthwhile to let haddock use a list of default interfaces, 
say on installation it would create a file with 
-i /usr/./base.haddock
-i /usr/./parsec.haddock cetera
in it, later a user might add other often used interfaces ?

Okay, writing one's own script isn't too hard, so there's no real need for it,
but it would be nice for dummies like me.

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


RE: [Haskell-cafe] Problem with Hyperlinking Haddock-documentation

2005-01-27 Thread Simon Marlow
On 27 January 2005 16:54, [EMAIL PROTECTED] wrote:

 BTW, would it be worthwhile to let haddock use a list of default
 interfaces, say on installation it would create a file with
 -i /usr/./base.haddock
 -i /usr/./parsec.haddock cetera
 in it, later a user might add other often used interfaces ?
 
 Okay, writing one's own script isn't too hard, so there's no real
 need for it, but it would be nice for dummies like me.

I'd like Haddock to know about installed packages, and in fact we're
part of the way there in GHC 6.4 because the package database now
includes the locations of the .haddock file and the HTML for each
package.  I just have to modify Haddock to query the package database...

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


[Haskell-cafe] wierd type errros with MPTCs

2005-01-27 Thread S. Alexander Jacobson
This code gives me a Kind error because IVal isn't 
applied to enough type arguments.

  import qualified Set
  class Table table indexVal | indexVal-table where
  --insertIndex::item-indexVal item - table item -table item
  union::table item - table item - table item
  --union t1 t2 = t1
  data DBTable item = DBTable
  data IVal item = Name item
  instance Table DBTable (IVal ) where
Weirdly, when I uncomment the insertIndex 
function, things work.  But, if I then uncomment 
the default implementation of union, I get:

  No instance for (Table DBTable indexVal)
arising from use of `Main.$dmunion' at example.hs:13
  In the definition of `union': union = Main.$dmunion
  In the definition for method `union'
  In the instance declaration for `Table DBTable IVal'
I don't know what this error even means.  But it 
goes away if I put the union implementation in the 
instance rather than in the class.

Bot these error messages seem unreasonable.  Can 
someone clarify?

Note: I am using GHC 6.2.2
-Alex-
__
S. Alexander Jacobson tel:917-770-6565 http://alexjacobson.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Marcin 'Qrczak' Kowalczyk
Robert Dockins [EMAIL PROTECTED] writes:

 More than you would think, if you follow the conventions of modern
 unix shells. eg, foo/.. is always equal to .,

For the OS it's not the same if foo is a non-local symlink.

Shells tend to resolve symlinks themselves on cd, and cd .. means
to remove the last component of the unexpanded current directory,
which may be different from the directory listed by ls ...

 (rather than doing a chdir on the .. hardlink, which does strange
 things in the presence of symlinks). The operation is sufficently
 useful that I think it should be included. It lets us know, for
 example, that /bar/../foo/tmp and /foo/tmp refer to the same
 file, without resorting to any IO operations.

I disagree. The point is they are *not* the same file.

-- 
   __( Marcin Kowalczyk
   \__/   [EMAIL PROTECTED]
^^ http://qrnik.knm.org.pl/~qrczak/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] field record update syntax

2005-01-27 Thread S. Alexander Jacobson
I have a lot of code of the form
  foo {bar = fn $ bar foo}
Is there a more concise syntax?  I am thinking 
the record equivalent of C's foo+=5...

I imagine there is some operator that does this e.g.
   foo {bar =* fn}
But I don't know what it is...
-Alex-
__
S. Alexander Jacobson tel:917-770-6565 http://alexjacobson.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] File path programme

2005-01-27 Thread robert dockins
While true, I don't see what this has to do with the choice between 
PathStart and Maybe PathRoot. The types are isomorphic; we can detect 
and simplify the /.. case either way.
True
Because of the above problem, I'm willing to treat path fragments 
(Relative in both lattices) as a special case. But we still need to be 
able to round-trip rel:abs and abs:rel pathnames, meaning that the 
PathRoot type won't necessarily be a genuine cwd-independent root any more.
So we'd like to treat path fragments as a special case (eg, one can only 
append a path fragment), but path fragments are ambiguous with paths 
rooted at the CWD (of the current drive, in windows).

I'm not sure how best to deal with this.  It would be nice to have a 
separate type for path fragments so you would not have to resort to 
'error' or such to prevent invalid appends, but you want relative paths 
to have the same type as path fragments because they can't be 
distinguished


 There are a few others.  I took a look at MSDN earlier and was
 astounded.
Is there an MSDN page that actually gives a grammar, or at least a 
taxonomy, of Win32 pathnames? That would be useful.
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/base/naming_a_file.asp
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/base/createfile.asp
The descriptions in CreateFile are as close as I could find.
Incidentally, NT doesn't do a perfect job of parsing its own pathnames. 
While experimenting I managed to create a file named .., different 
from the directory .. (both show up in the directory listing), which I 
was subsequently unable to read or delete. The command was something 
like cat  ..:foo. I doubt that this behavior is by design.
That doesn't surprise me; it does make things painful, however.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] wierd type errros with MPTCs

2005-01-27 Thread Tomasz Zielonka
On Thu, Jan 27, 2005 at 12:53:24PM -0500, S. Alexander Jacobson wrote:
 This code gives me a Kind error because IVal isn't 
 applied to enough type arguments.
 
   import qualified Set
 
   class Table table indexVal | indexVal-table where
   --insertIndex::item-indexVal item - table item -table item
   union::table item - table item - table item
   --union t1 t2 = t1
 
   data DBTable item = DBTable
   data IVal item = Name item
 
   instance Table DBTable (IVal ) where
 
 Weirdly, when I uncomment the insertIndex 
 function, things work.

That's because Haskell has to commit to some kind for indexVal and
without any hits it chooses kind *. You can explicitly state the kind of
indexVal.

class Table table (indexVal :: * - *) | indexVal-table where

I can't help you with the other problem. The Main.$dmunion name in the
message is indeed scary.

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Marcin 'Qrczak' Kowalczyk
John Meacham [EMAIL PROTECTED] writes:

 too bad we can't do things like

 #if exists(module System.Path) 
 import System.Path
 #else
 ...
 #endif

 I still find it perplexing that there isn't a decent standard haskell
 preprocessor 

For my language Kogut I designed a syntax

   ifDefined condition {
  something
   }
   otherCondition {
  something else
   }
   ...

where a condition is an identifier whose definedness is tested, or
module ModuleName for existence of a module, or _ which is always
true, or their combination using conjunctions, alternatives and
negations.

The construct can be an expression (no condition is true = Null,
which makes sense with dynamic typing), a definition (no condition
is true = nothing is defined) or a pattern (no condition is true =
a pattern which never matches).

It does not subsume Common Lisp's #+ and #- nor vice versa. In Lisp
it is done at read time, not compile time, which has some advantages,
but is incompatible with temporal separation of compilation phases.

Even though definitions may in general be mutually recursive,
similarly as in Haskell, ifDefined depends only on definitions above
it. This is hard to avoid, because its expansion may influence the set
of definitions which will be present.

-- 
   __( Marcin Kowalczyk
   \__/   [EMAIL PROTECTED]
^^ http://qrnik.knm.org.pl/~qrczak/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] File path programme

2005-01-27 Thread robert dockins
 - Keep the existing System.IO API the same. openFile, createDirectory
... will take the file path as string.
The problem is that string means different things in haskell and in C.
A C string is really just a contiguous sequence of octets in memory. 
A haskell string has a particular interpretation, that of a list of 
unicode characters.  Depending on how strings come into and leave the 
haskell world, there may OR MAY NOT be a one-to-one mapping between C 
strings and haskell strings, if non-trivial character encodings are 
involved (they will be eventually).  Decoding may fail (no haskell 
representation for that string), or it might be that (deocde . encode) 
/= id, which is also bad (file name returned from a directory listing 
gives file not found error).  The sad truth is that FilePath = String is 
BROKEN.  FilePath = [Word8] would at least preserve filenames as they 
move across the boundaries of the haskell world, but then simple 
questions like does this file have a .gz ending become difficult 
(because they depend on the encoding).  We need something else.  Maybe 
ADTs aren't it, but String certainly isn't.  I don't think mostly 
works, if you only use ASCII is good enough for something as basic as 
file IO.

 In most cases we do only simple manipulations on path 
Even simple manipulations break in the presence of encoding issues, or 
even just of unusual paths.  What is the extension of \\.\TAPE0 ?  Its 
not \TAPE0.  BTW this is a valid path on Windows 2000 upwards.  If you 
don't care about corner cases, then you have no worries.  It would be 
nice to have correct handling for all valid paths on each supported OS 
though.

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread robert dockins

Even simple manipulations break in the presence of encoding issues, or 
even just of unusual paths.  What is the extension of \\.\TAPE0 ?  Its 
not \TAPE0.  BTW this is a valid path on Windows 2000 upwards.  If you 
don't care about corner cases, then you have no worries.  It would be 
nice to have correct handling for all valid paths on each supported OS 
though.
Urk.  This is a terrible example, sorry.  Still, the point is that 
unusual paths can break simple seeming string manipulations.

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


Re: [Haskell-cafe] Converting from Int to Double

2005-01-27 Thread Dmitri Pissarenko
Thanks!
--
Dmitri Pissarenko
Software Engineer
http://dapissarenko.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] field record update syntax

2005-01-27 Thread Henning Thielemann

On Thu, 27 Jan 2005, S. Alexander Jacobson wrote:

 I have a lot of code of the form

foo {bar = fn $ bar foo}

 Is there a more concise syntax?  I am thinking
 the record equivalent of C's foo+=5...

 I imagine there is some operator that does this e.g.

 foo {bar =* fn}

 But I don't know what it is...

If you have only few different record fields you may like to define an
update function for each record field.

updateBar fn foo = foo {bar = fn (bar foo)}

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


Re: [Haskell-cafe] Question on case x of g when g is a function

2005-01-27 Thread Hamilton Richards
If he really wanted to use a case-expression, he could write it this way:
 f x = case x of
False - 0
True  - 1
--Ham
At 1:02 PM +0100 2005/1/27, Henning Thielemann wrote:
On Thu, 27 Jan 2005 [EMAIL PROTECTED] wrote:
 Can a kind soul please enlighten me on why f bit0 and f bit1
 both return 0?
  bit0 = False
  bit1 = True
  f x = case x of
  bit0 - 0
  bit1 - 1
If you compile with 'ghc -Wall' GHC should report that the identifier
'bit0' in the case expression shadows the global 'bit0' identifier. What
you want to do is:
f x = if x == bit0 then 0 else 1
___
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] wierd type errros with MPTCs

2005-01-27 Thread Daniel Fischer
Am Donnerstag, 27. Januar 2005 18:53 schrieb S. Alexander Jacobson:
 This code gives me a Kind error because IVal isn't
 applied to enough type arguments.

import qualified Set

class Table table indexVal | indexVal-table where
--insertIndex::item-indexVal item - table item -table item
union::table item - table item - table item
--union t1 t2 = t1

data DBTable item = DBTable
data IVal item = Name item

instance Table DBTable (IVal ) where

 Weirdly, when I uncomment the insertIndex
 function, things work.  But, if I then uncomment

I'm not sure about this, but I believe that the type-variable indexVal in the 
class definition is defaulted to kind *.
Now IVal has kind * - *, so the instance declaration doesn't kind-match.
If you uncomment insertIndex, ghc can see that indexVal must have kind * - *, 
so things work.

 the default implementation of union, I get:

No instance for (Table DBTable indexVal)
  arising from use of `Main.$dmunion' at example.hs:13
In the definition of `union': union = Main.$dmunion
In the definition for method `union'
In the instance declaration for `Table DBTable IVal'

 I don't know what this error even means.  But it
 goes away if I put the union implementation in the
 instance rather than in the class.

I don't see what's wrong there either.
Maybe consulting the user's guide will help.

 Bot these error messages seem unreasonable.  Can
 someone clarify?

Hope,
a) I got it right,
b) it helped.

 Note: I am using GHC 6.2.2

 -Alex-

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


Re: [Haskell-cafe] File path programme

2005-01-27 Thread Krasimir Angelov
I don't pretend to fully understand various unicode standard but it
seems to me that these problems are deeper than file path library. The
equation (decode . encode)
/= id seems confusing for me. Can you give me an example when this
happen? What can we do when the file name is passed as command line
argument to program? We need to convert String to FilePath after all.

 Even simple manipulations break in the presence of encoding issues, or
 even just of unusual paths.  What is the extension of \\.\TAPE0 ?  Its
 not \TAPE0.  BTW this is a valid path on Windows 2000 upwards.  If you
 don't care about corner cases, then you have no worries.  It would be
 nice to have correct handling for all valid paths on each supported OS
 though.

Yes it isn't. If the library makes proper parsing it will return no extension.

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


Re: [Haskell-cafe] RE: Answers to Exercises in Craft of FP

2005-01-27 Thread Christian Hofer
Dear Hamilton,
I think we just have a different framing of the problem. You are 
confronted with the laziness of students and want to teach them 
something anyway. By that you are forced to disrespect the autonomy of 
students who are intrinsically motivated (e.g. by giving bonus points 
on exercises).

I on the other hand am a great fan of the old German university system, 
which they are currently about to abolish in the so-called Bologna 
Process. The idea is to just treat students as if they were 
autonomous. Most students fail in the exams in their first year, 
because they are not used to solving exercises when nobody forces them 
to do it (s.th. they should of course already have learned in school). 
Those students that don't recover don't belong to university. But most 
students learn from this negative experience, that they have to work on 
their own. And that is more important to learn on university than the 
details of a certain programming paradigm...

It's nice that you offer me your exercises with solutions. But I am 
afraid that does not really help me, because I want to do (and am 
actually doing) the exercises in the books that I read (because that is 
the way to get a better understanding). Thus what I would need are the 
solutions to those exercises.

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