[Haskell-cafe] Re: Network.HTTP+ByteStrings Interface--Or: How to shepherd handles and go with the flow at the same time?

2007-05-25 Thread Pete Kazmier
As a newbie to Haskell, I found your thorough analysis very
interesting.  Thanks for the great read!  I have a few questions
regarding some of your comments, see below:

Jules Bean <[EMAIL PROTECTED]> writes:
> E,F. Progressive GET
> pSynGET :: URL -> ((Bool,ByteString) -> IO ()) -> IO ()
> pAsynGET :: URL -> ((Bool,ByteString) -> IO ()) -> IO (MVar ())
> 
> (This is a particular simple case of Oleg's iteratees, I
> think) Download the data at whatever speed is convenient. As data
> arrives, feed it to the 'callback' provided. The ByteString is the
> new chunk of data, the 'Bool' is just supposed to indicate whether
> or not this is the final chunk.

> Incidentally there are more complex options than (Bool,Bytestring)
> -> IO ().  A simple and obvious change is to add a return
> value. Another is a 'state monad by hand', as in (Bool,Bytestring)
> -> s -> s, and change the final return value of the type to IO s,
> which allows the callback to accumulate summary information and
> still be written as pure code. 

I want to be sure that I understand the implications of the callback
function returning an IO action as originally proposed versus it being
a pure function.  It would seem to me that if it were a pure callback
the usefulness would be limited as I would not be able to take the
data read from the network and immediately write it out to a file.  Is
this correct?

And if the above is correct, is there a way to define the callback
such that one does not have to hardcode the IO monad in the return
type so you can have the best of both worlds?

> Other options allow the 'callback' to request early termination,
> by layering in an 'Either' type in there. 

I believe the ability to request early termination is important, and
was one of the nice features of Oleg's left-fold enumerators.  It
would be a shame if the API did not offer this capability.

> Another more sophisticated option, I think, is the higher rank
>
> MonadTrans t => URL ->
>  ((forall m. Monad m) => (Bool,ByteString) -> t m)
>  -> t IO ()
>
> ...which, unless I've made a mistake, allows you to write in 'any
> monad which can be expressed as a transformer', by transforming it
> over IO, but still contains the implicit promise that the
> 'callback' does no IO. For example t = StateT reduces to the
> earlier s -> s example, in effect, with a slightly different data
> layout.

I don't fully understand this, but would this prevent one from calling
IO actions as it was receiving the chunks in the callback (such as
writing it to a file immediately)?


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


Re: [Haskell-cafe] instance Monad AppF - Faster than the list monad?

2007-05-25 Thread Donald Bruce Stewart
greenrd:
> The following Haskell 98 module implements a generalisation of
> Prelude.ShowS for any type. Should be pretty easy to incorporate this
> into code which currently uses the list monad non-trivially, and get
> better performance - but can this be right? Surely someone would have
> published this before if that was true? I haven't actually done any
> performance tests. Anyway, with this module you end up using function
> composition instead of list concatenation - except when converting from
> a list.
> 
> module Data.List.AppF where
> 
> import Control.Monad (MonadPlus (mplus, mzero), msum)
> 
> -- Generalisation of ShowS
> newtype AppF a = AppF { unAppF :: [a] -> [a] }
> 
> instance Monad AppF where
> (>>=) = (msum .) . flip map . appFToList
> return = AppF . (:)
> 
> instance MonadPlus AppF where
> mzero = AppF id
> mplus x y = AppF $ unAppF x . unAppF y
> 
> -- Use this to convert Maybe a into AppF a, or indeed any other
> -- MonadPlus instance.
> maybeToMonadPlus :: MonadPlus m => Maybe a -> m a
> maybeToMonadPlus = maybe mzero return
> 
> listToAppF :: [a] -> AppF a
> listToAppF = AppF . (++)
> 
> appFToList :: AppF a -> [a]
> appFToList = ($ []) . unAppF

Very nice!  Perhaps stick it on the wiki, or send it as a patch to the
dlist library?

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/dlist-0.2

I'd be happy to package it in that.

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


[Haskell-cafe] instance Monad AppF - Faster than the list monad?

2007-05-25 Thread Robin Green
The following Haskell 98 module implements a generalisation of
Prelude.ShowS for any type. Should be pretty easy to incorporate this
into code which currently uses the list monad non-trivially, and get
better performance - but can this be right? Surely someone would have
published this before if that was true? I haven't actually done any
performance tests. Anyway, with this module you end up using function
composition instead of list concatenation - except when converting from
a list.

module Data.List.AppF where

import Control.Monad (MonadPlus (mplus, mzero), msum)

-- Generalisation of ShowS
newtype AppF a = AppF { unAppF :: [a] -> [a] }

instance Monad AppF where
(>>=) = (msum .) . flip map . appFToList
return = AppF . (:)

instance MonadPlus AppF where
mzero = AppF id
mplus x y = AppF $ unAppF x . unAppF y

-- Use this to convert Maybe a into AppF a, or indeed any other
-- MonadPlus instance.
maybeToMonadPlus :: MonadPlus m => Maybe a -> m a
maybeToMonadPlus = maybe mzero return

listToAppF :: [a] -> AppF a
listToAppF = AppF . (++)

appFToList :: AppF a -> [a]
appFToList = ($ []) . unAppF
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] OSCON 2007, who's going?

2007-05-25 Thread Evan Lenz
I'll be there for the Haskell tutorial (and Damian Conway's Vim 
tutorial). I've been to OSCON one other time (2005) and that was to 
present a tutorial on XSLT. I won't be staying for the conference though.


Portland is nice. I live in Seattle, and we make it down there every so 
often.


Evan

Christopher Milton wrote:

Are a lot of Haskellers going to be at OSCON, or just
Simon Peyton Jones and myself?

http://conferences.oreillynet.com/os2007/

I've never been to Portland, Oregon, before.


Chris Milton
AIM: cmiltonperl
___
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] Yet another top-level state proposal

2007-05-25 Thread Judah Jacobson

Hi all,

Given the recent discussion about adding top-level mutable state to
Haskell, I thought it might be a good time to throw my own proposal
into the ring.  If enough people think it's worth considering, I can
add it to the wiki page.
(http://www.haskell.org/haskellwiki/Top_level_mutable_state)

In contrast to recent proposals, this one requires no extra syntax or
use of unsafe functions by the programmer.  Any nonstandard "magic"
that might occur is kept within the compiler internals.  Furthermore,
top-level initializations are only executed when needed; merely
importing a module does not cause any additional actions to be run at
startup.

The core idea, similar to that of "type-based execution contexts" on
the above wiki page, is to associate each top-level action with its
own type.  For example, the current way to declare a source for unique
integers is:


{-# NOINLINE uniqueRef #-}
uniqueRef :: IORef Integer
uniqueRef = unsafePerformIO $ newIORef 0

uniqueInt :: IO Integer
uniqueInt = do
   n <- readIORef uniqueRef
   writeIORef uniqueRef (n+1)
   return n

Under this proposal, we would write instead:

newtype UniqueRef = UniqueRef (IORef Integer)
   deriving OnceIO

instance OnceInit UniqueRef where
   onceInit = liftM UniqueRef (newIORef 0)

uniqueInt :: IO Integer
uniqueInt = do
   UniqueRef uniqueRef <- runOnceIO
   n <- readIORef uniqueRef
   writeIORef uniqueRef (n+1)
   return n


The above code uses two classes:

class OnceInit a where
   onceInit :: IO a

class OnceInit a => OnceIO a where
   runOnceIO :: IO a

The OnceInit class lets the programmer to specify how a type is
initialized; above, it just allocates a new IORef, but we could also
read a configuration file or parse command-line arguments, for
example.

In contrast, instances of the OnceIO class are not written by the
programmer; instead, they are generated automatically by a "deriving
OnceIO" clause.Each type for which OnceIO is
derived will have a special top-level action associated with it, which
is accessed through the runOnceIO function.  Its semantics are:

- The first time that "runOnceIO" is called, it runs the corresponding
"onceInit" action and caches and returns the result.
- Every subsequent time that "runOnceIO" is called, it returns the
cached result.

This behavior is safe precisely because runOnceIO is an IO action.
Even though one can't guarantee when in the program an initialization
will occur, when the initialization does happen it will be sequenced
among other IO actions.

To illustrate this behavior, here are a couple sample implementations
in plain Haskell.  These do use unsafePerformIO, but in practice any
such details would be hidden in the instance derived by the compiler
(along with any related NOINLINE/NOCSE pragmas):

instance Once UniqueRef where
   runOnceIO = return $! unsafePerformIO onceInit

or (less efficient, but multithreaded safe):

instance Once UniqueRef where
   runOnceIO = modifyMVar onceUniqueRef $ \mx -> case mx of
   Just x -> return (Just x, x)
   Nothing -> do {x <- onceInit; return (Just x, x)}

onceUniqueRef = unsafePerformIO $ newMVar Nothing

Finally, note that the deriving clause can easily check whether the
type in question is monomorphic (as is necessary for type-safety),
since it already has access to the type definition.


Anyway, that's the gist of my proposal; I hope I've explained it well,
but please let let me know if you have questions, suggestions or
criticisms.

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Clifford Beshers

Donald Bruce Stewart wrote:

I've always thought that the obfuscation opportunities for Num
literal overloading, combined with Num *overflowing* were
underappreciated.
  


Search for 'mel blackjack'.  You and Mel would get along fine.

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


Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Clifford Beshers

Scott Cruzen wrote:


I'd like to suggest the Mantis shrimp because they have excellent
vision, they're long lived and they pack a punch.


  


They certainly do.  An excellent choice.

Personally, I'd like to see the Giant Sea Bass., just because they're so 
stately:


http://week.divebums.com/2006/Sep05-2006/index.html
http://week.divebums.com/2006/Aug28-2006/index.html

Actually, I'd like to see my favorite fish, the Sarcastic Fringehead, 
but I'm trying to  be somewhat realistic:


http://week.divebums.com/2006/Oct02-2006/fringehead_steve-murvine.jpg
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: The danger of Monad ((->) r)

2007-05-25 Thread Isaac Dupree
-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1


Conal Elliott wrote:
> -- Standard instance: applicative functor applied to monoid
> instance Monoid a => Monoid (IO a) where
>  mempty  = pure mempty
>  mappend = (*>)
> 
> On second thought, I don't really like (*>), since it's easy to
> accidentally
> discard a useful value.  (I dislike (>>) for the same reason.) 

Exactly; because they don't make monoids, because (x `mappend` mempty)
isn't (x), so mempty isn't a right-identity of mappend, so the instance
doesn't follow the monoid laws.

Isaac

-BEGIN PGP SIGNATURE-
Version: GnuPG v1.4.6 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iD8DBQFGV2hZHgcxvIWYTTURAjlsAJ0fyUrqYAx09neVi2/FN+sUQobEUACfWAph
2WJwISDe/11pg41lcV80uik=
=SYQB
-END PGP SIGNATURE-
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Neil Mitchell

Hi


> 3) I can browse a Subversion repository with a web browser instead of
> having to download code from the repository from the command line (of
> course command line is still available). Sometimes viewing a version
> of a code sample online is all that is needed to answer a question,
> and in that case I prefer to look instead of downloading a file that I
> have to delete.

Darcs does have Darcsweb that can be used for the same purpose, with
the full array of Darcs viewing features. Darcsweb isn't nearly as
widespread as ViewCVS and the like, but it exists and can be set up
easily enough.


http://darcs.haskell.org/darcsweb/darcsweb.cgi?r=yhc;a=summary - most
things on haskell.org have a darcsweb, thats the one for Yhc.

Plus I suspect that darcs will be discussed in the book, for building
a library, in which case its only sensible to dogfood your own stuff.
Not that darcs is dogfood, more like a chocolate cake :)

Thanks

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


Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Robin Green
On Fri, 25 May 2007 19:39:19 +0100
"Neil Mitchell" <[EMAIL PROTECTED]> wrote:
> http://darcs.haskell.org/darcsweb/darcsweb.cgi?r=yhc;a=summary - most
> things on haskell.org have a darcsweb, thats the one for Yhc.
> 
> Plus I suspect that darcs will be discussed in the book, for building
> a library, in which case its only sensible to dogfood your own stuff.
> Not that darcs is dogfood, more like a chocolate cake :)

*puts on flameproof suit*

Not really, due to the whole "bug #1" thing (broken merging).
-- 
Robin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Albert Y. C. Lai

Donald Bruce Stewart wrote:

instance Num String anyone? Mwhaha
  

addString xs ys = add 0 xs ys
   where
 m = fromEnum (maxBound :: Char) + 1
 alu c x y =
 let s = c + fromEnum x + fromEnum y
 in if s >= m then (1, s-m) else (0, s)
 add c (x:xs) (y:ys) = case alu c x y of (c', s') -> toEnum s' : add c' xs 
ys
 add c [] (y:ys) = case alu c 0 y of (0, s') -> toEnum s' : ys
 (1, s') -> toEnum s' : add 1 [] ys
 add c xs@(_:_) [] = add c [] xs
 add c [] [] = if c==0 then [] else [toEnum c]


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


[Haskell-cafe] OSCON 2007, who's going?

2007-05-25 Thread Christopher Milton
Are a lot of Haskellers going to be at OSCON, or just
Simon Peyton Jones and myself?

http://conferences.oreillynet.com/os2007/

I've never been to Portland, Oregon, before.


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


Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Anthony Chaumas-Pellet
> 3) I can browse a Subversion repository with a web browser instead of
> having to download code from the repository from the command line (of
> course command line is still available). Sometimes viewing a version
> of a code sample online is all that is needed to answer a question,
> and in that case I prefer to look instead of downloading a file that I
> have to delete.

Darcs does have Darcsweb that can be used for the same purpose, with
the full array of Darcs viewing features. Darcsweb isn't nearly as
widespread as ViewCVS and the like, but it exists and can be set up
easily enough.

For the 'I only want to check a file' scenario, you don't need any
kind of software; just point your browser towards the file, in plain
HTTP style.

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


[Haskell-cafe] Broadcast signals between threads

2007-05-25 Thread Joachim Breitner
[Arg. Just lost the mail and have to re-type it. Sorry if I’m not as
verbose as I should be].

Hi,

I’m writing a TCP server app ATM. It has one thread per client. Some of
the clients want to be notified if the internal state changes, while
others are happily chatting with the server, possible modifying the
internal state. What I need now is a way for the chatting thread to
signal “anyone interested” that the state has changed.

The semantics should be roughly these:
 * All listening threads run some wait-for-signal command that blocks
until the signal is sent.
 * The state changing thread notifies the others by some
signal-sending-command, which should not block.
 * It does not matter if no one is listening, or if threads miss signals
because they are doing something else for the moment, or if several sent
signals are handled only once.

Here is my implementation so far:

newtype MSignal a = MS (MVar a)

newMSignal = MS `liftM` newEmptyMVar

sendMSignal (MS mv) v = do
forkIO $ takeMVar mv >> return () -- Cleanup afterwards
putMVar mv v

receiveMSignal (MS mv) = readMVar mv

It builds on MVar’s promise that takeMVar and readMVar commands are
handled FIFO, so by spawning a takeMVar thread, the sender ensures that
exactly after all currently waiting threads are served the value is
taken out of the MVar and everything is done. readMVar will both take
the value and put it back, so that the next waiting thread (or the
sending thread’s cleanup thread) can take the value.

Do you think this is a sensible way to do it? Any pitfalls that I have
overlooked? Might this be useful enough to be included in some
mainstream library?

Greetings,
Joachim

-- 
Joachim Breitner
  e-Mail: [EMAIL PROTECTED]
  Homepage: http://www.joachim-breitner.de
  ICQ#: 74513189
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: The danger of Monad ((->) r)

2007-05-25 Thread Conal Elliott

Oops -- I wasn't watching this thread.  I like Jules's definition, though
I'd write it as follows.

-- Standard instance: monad applied to monoid
instance Monoid a => Monoid (IO a) where
 mempty  = return mempty
 mappend = liftM2 mappend

You can replace "IO" with any monad at all, to make similar instances.

Here's the instance i use.  It's in Control.Instances in the TypeCompose
library.  See http://www.haskell.org/haskellwiki/TypeCompose.

-- Standard instance: applicative functor applied to monoid
instance Monoid a => Monoid (IO a) where
 mempty  = pure mempty
 mappend = (*>)

On second thought, I don't really like (*>), since it's easy to accidentally
discard a useful value.  (I dislike (>>) for the same reason.)  Generalizing
the "monad applied to monoid" instance above:

-- Standard instance: applicative functor applied to monoid
instance Monoid a => Monoid (IO a) where
 mempty  = pure mempty
 mappend = liftA2 mappend

That will be the definition in the next TypeCompose release.

All of these instances agree for a = ().  The first & third are more
compelling to me than the second, since they make full use of the Monoid a
constraint.

Cheers,  - Conal

On 5/16/07, Jules Bean <[EMAIL PROTECTED]> wrote:


Tomasz Zielonka wrote:
> On Wed, May 16, 2007 at 09:28:31AM +0100, Jules Bean wrote:
>
>> Tomasz Zielonka wrote:
>>
>>> You mean using the (Monoid b) => Monoid (a -> b) instance ?
>>> I can see that IO () makes a perfect Monoid, but there doesn't seem to
>>> be a standard instance for that.
>>>
>> Indeed, all Monads are Monoids (that is, if m :: * -> * is a Monad,
then
>> m a :: * is a Monoid, for any fixed type a) by using >>.
>>
>
> Are you sure that (IO Int) is a monoid with mappend = (>>)? How do you
> define mempty, so it is an identity for mappend?
>
> It would help if type a was a Monoid, then:
>
> mempty = return mempty
> mappend mx my = do
> x <- mx
> y <- my
> return (x `mappend` y)
>
> It's easier if a = ().
>

Oops, you're right. I spoke too fast.

It's only a monoid for (). Otherwise you can't hope to have a right
identity.

Jules


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


Re: [Haskell-cafe] Shared libraries in GHC

2007-05-25 Thread Andrew Coppin



Just say you have cleverly avoided "dll hell" and charge a bit more
money... ;-)
  


Oh, that's *advanced*! :-D

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


Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Doug Kirk

Last time I read O'Reilly's policy, it stated that you're free to
suggest an animal, but that they have a full-time person that makes
the decision on which animal is on the book.

However, the bigger issue is that anybody familiar with O'Reillys
product lines knows that their "Real World" series doesn't have any
animals at all!


On 5/23/07, Dan Weston <[EMAIL PROTECTED]> wrote:

What power animal have you chosen for the cover of your O'Reilly book?
Alas, most of the good ones are gone already!

Donald Bruce Stewart wrote:
> Bryan O'Sullivan, Don Stewart and John Goerzen are pleased, and frankly,
> very excited to announce that were developing a new book for O'Reilly, on
> practical Haskell programming. The working title is Real-World Haskell.
>
> The plan is to cover the major techniques used to write serious,
> real-world Haskell code, so that programmers can just get to work in the
> language. By the end of the book readers should be able to write real
> libraries and applications in Haskell, and be able to:
>
> * design data structures
> * know how to write, and when to use, monads and monad transformers
> * use Haskells concurrency and parallelism abstractions
> * be able to write parsers for custom formats in Parsec.
> * be able to do IO and binary IO of all forms
> * be able to bind Haskell to foreign functions in C
> * be able to do database, network and gui programming
> * know how to do exception and error handling in Haskell
> * have a good knowledge of the core libraries
> * be able to use the type system to track and prevent errors
> * take advantage of tools like QuickCheck, Cabal and Haddock
> * understand advanced parts of the language, such as GADTs and MPTCs.
>
> That is, you should be able to just write Haskell!
>
> The existing handful of books about Haskell are all aimed at teaching
> programming to early undergraduate audiences, so they are ill-suited to
> people who already know how to code. And while theres a huge body of
> introductory material available on the web, you have to be both
> tremendously motivated and skilled to find the good stuff and apply it
> to your own learning needs.
>
> The time has come for the advanced, practical Haskell book.
>
> Heres the proposed chapter outline:
>
>1. Why functional programming? Why Haskell?
>2. Getting started: compiler, interpreter, values, simple functions, and 
types
>3. Syntax, type system basics, type class basics
>4. Write a real library: the rope data structure, cabal, building projects
>5. Typeclasses and their use
>6. Bringing it all together: file name matching and regular expressions
>7. All about I/O
>8. I/O case study: a DSL for searching the filesystem
>9. Code case study: barcode recognition
>   10. Testing the Haskell way: QuickCheck
>   11. Handling binary files and formats
>   12. Designing and using data structures
>   13. Monads
>   14. Monad case study: refactoring the filesystem seacher
>   15. Monad transformers
>   16. Using parsec: parsing a bioinformatics format
>   17. Interfacing with C: the FFI
>   18. Error handling
>   19. Haskell for systems programming
>   20. Talking to databases: Data.Typeable
>   21. Web client programming: client/server networking
>   22. GUI programming: gtk2hs
>   23. Data mining and web applications
>   24. Basics of concurrent and parallel Haskell
>   25. Advanced concurrent and parallel programming
>   26. Concurrency case study: a lockless database with STM
>   27. Performance and efficiency: profiling
>   28. Advanced Haskell: MPTCs, TH, strong typing, GADTs
>   29. Appendices
>
> We're seeking technical reviewers from both inside and outside the
> Haskell community, to help review and improve the content, with the
> intent that this text will become the standard reference for those
> seeking to learn serious Haskell. If you'd like to be a reviewer, please
> drop us a line at [EMAIL PROTECTED], and let us
> know a little about your background and areas of interest.
>
> Finally, a very exciting aspect of this project is that O'Reilly has
> agreed to publish chapters online, under a Creative Commons License!
> Well be publishing chapters incrementally, and seeking feedback from our
> reviewers and readers as we go.
>
> You can find more details and updates at the following locations:
>
> * The web site, http://www.realworldhaskell.org/blog/welcome/
> * The authors,  http://www.realworldhaskell.org/blog/about/
> * The blog, http://www.realworldhaskell.org/blog/
>
> -- Bryan O'Sullivan, Don Stewart and John Goerzen.
> ___
> 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


___
Haske

Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Doug Kirk

What about a public darcs repository where people can constantly download
and review modifications? People could even send patches to the authors
(editors?).


I realise that everyone wants to eat their own dog food, but really,
if you want the code samples to be available to the masses, you'll use
Subversion instead of darcs.

No offense to the darcs creators, but

1) Only current Haskellers use it; everyone else either uses
Subversion or is migrating to it;
2) It's not suitable for medium- to large-scale software development
(after 24 hrs+ of importing code for a project underway, still
incomplete, I cancelled it and used Subversion, which completed its
import in 45 minutes);
3) I can browse a Subversion repository with a web browser instead of
having to download code from the repository from the command line (of
course command line is still available). Sometimes viewing a version
of a code sample online is all that is needed to answer a question,
and in that case I prefer to look instead of downloading a file that I
have to delete.

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


[Haskell-cafe] Resend: seeking code review

2007-05-25 Thread Justin Bailey

I'm resending my message of yesterday with the code as a zipped
attachment. Any and all feedback is welcome. My apologies in advance
for the double-post!


From the documentation:


"This module provides a set of functions for building simple
command-line interfaces. It allows interfaces which collect values
(such as Integers, Dates, and more structured values), build lists of
values, and use simple menus. It is not intended to build complex
interfaces with full cursor control. It is oriented towards line-based
interfaces."

Justin


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


Re: [Haskell-cafe] Shared libraries in GHC

2007-05-25 Thread Magnus Therning
On Fri, May 25, 2007 at 12:31:26 +, Georg Sauthoff wrote:
>Hi,
>
[..]
>Btw, the problem I want to solve with shared libraries is the case,
>where I want to program 2 frontends (==2 executables), which share a
>lot of Haskell-Code. I am afraid, if both frontends are linked
>statically, the result will look a bit 'bloated' ...

Just say you have cleverly avoided "dll hell" and charge a bit more
money... ;-)

/M

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


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


[Haskell-cafe] Re: Stack overflow

2007-05-25 Thread Grzegorz
Albert Y. C. Lai  vex.net> writes:

> ...
> and that does it.
> 

Indeed it does, thank you!
--
Grzegorz




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


Re: [Haskell-cafe] New book: Real-World Haskell!

2007-05-25 Thread Magnus Therning
On Thu, May 24, 2007 at 20:37:12 +0100, Andrew Coppin wrote:
>Magnus Therning wrote:
>>On Wed, May 23, 2007 at 15:22:05 -0700, Scott Cruzen wrote:
>>  
>>>* Dan Weston <[EMAIL PROTECTED]> [070523 12:41]:
>>>
 What power animal have you chosen for the cover of your O'Reilly
 book? Alas, most of the good ones are gone already!
  
>>>I'd like to suggest the Mantis shrimp because they have excellent
>>>vision, they're long lived and they pack a punch.
>>>
>>>I haven't checked, but it's almost certainly not already used.
>>>
>>>http://en.wikipedia.org/wiki/Mantis_shrimp
>>>
>>
>>They have their menagerie online[1] so it's easy to check what animals
>>that have been used already.  Personally I think a sloth would be suited
>>for a lazy language like Haskell :-)
>>  
>
>Oh that has *got* to be used already! ;-)

I thought so too, but it doesn't seem to be.

However, it seems the list I pointed to isn't complete.  There's an
O'Reilly book about OpenSSL that has sea lions and seals on the cover,
however I couldn't find it among the titles.

/M

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


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


[Haskell-cafe] Shared libraries in GHC

2007-05-25 Thread Georg Sauthoff
Hi,

while searching, if ghc can create packages as shared libraries I found
a ticket with a kind of non-accepted status:
http://hackage.haskell.org/trac/summer-of-code/ticket/46

But at the google SoC page it looks like an accepted project:
http://code.google.com/soc/haskell/appinfo.html?csaid=D0137F8B637176F1

Well what is the status of the project? Does the student have a
blog/webpage where one can track the progress of the project?

Btw, the problem I want to solve with shared libraries is the case,
where I want to program 2 frontends (==2 executables), which share a lot
of Haskell-Code. I am afraid, if both frontends are linked statically,
the result will look a bit 'bloated' ...

Best regards
Georg Sauthoff

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


Re: [Haskell-cafe] mac os x installation problem

2007-05-25 Thread bkw479

There is a way to use MacPorts.

http://www.macports.org/


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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Paul Johnson
L.Guo wrote:
> Without thinking about for Word8, [1,18..256] is equal to [1,18..0]. Though
> I try to use "$!" to let GHC generate the list as Integer. It would not do so.
$! merely forces evaluation; it doesn't change the types.

What you want is more like:

ws: [Word8]
ws = map fromIntegral [1,18..256 :: Int]


There is no need for multi-precision Integers here: Int will do just fine.

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


[Haskell-cafe] Re: mac os x installation problem

2007-05-25 Thread Christian Maeder
You need the GNUreadline (and GMP) framework, too.

(ie. as root)
unzip GNUreadline-framework.zip -d /Library/Frameworks
unzip GMP-framework.zip -d /Library/Frameworks

http://www.informatik.uni-bremen.de/agbkb/forschung/formal_methods/CoFI/hets/mac_e.htm
http://www.informatik.uni-bremen.de/agbkb/forschung/formal_methods/CoFI/hets/mac/GNUreadline-framework.zip

Ian Lynagh, could make this more clear on
http://www.haskell.org/ghc/download_ghc_661.html
and possibly put these frameworks on your servers, too?

The same problem was described here:
http://hackage.haskell.org/trac/ghc/ticket/1367

Cheers Christian

Edwin Chen schrieb:
> I'm having some trouble installing ghc on my MacBook (running 10.4).
> I did
> ./configure
> make install
> but then I get
> me$ ghci
> -bash: ghc: command not found
> 
> So I tried adding /usr/local/bin to my path (that's the default
> installation
> location, right?), and now I get
> 
> me$ ghci
> dyld: Library not loaded: GNUreadline.framework/Versions/A/GNUreadline
>  Referenced from: /usr/local/lib/ghc-6.6.1/ghc-6.6.1
>  Reason: image not found
> Trace/BPT trap
> 
> Any idea what's wrong? Thanks
> 
> 
> 
> 
> ___
> 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] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
ketil:
> On Fri, 2007-05-25 at 17:33 +1000, Donald Bruce Stewart wrote:
> 
> > Sorry, I should clarify, think about how to represent:
> > 
> > 256 :: Word8
> 
> So the error isn't really divide by zero, but overflow.  I've been
> bitten by this, too, and L.Guo should count him/herself lucky to get an
> error, and not just incorrect results.

I've always thought that the obfuscation opportunities for Num
literal overloading, combined with Num *overflowing* were
underappreciated.

instance Num String anyone? Mwhaha


-- Don

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Ketil Malde
On Fri, 2007-05-25 at 17:33 +1000, Donald Bruce Stewart wrote:

> Sorry, I should clarify, think about how to represent:
> 
> 256 :: Word8

So the error isn't really divide by zero, but overflow.  I've been
bitten by this, too, and L.Guo should count him/herself lucky to get an
error, and not just incorrect results.

IMO, this is a rather nasty hole in the safety nets that Haskell is so
abundantly endowed with.  Does any Haskell implementation support
overflow detection?

-k


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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread L.Guo
I think it likes a trap. See this.

Data.ByteString.unpack . Data.ByteString.pack $! ([0,17..255] ++ [1,18..256])

Without thinking about for Word8, [1,18..256] is equal to [1,18..0]. Though
I try to use "$!" to let GHC generate the list as Integer. It would not do so.

:-L

--   
L.Guo
2007-05-25

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread L.Guo
When I was tring manually truncate data to Word8 to fill into
ByteString, I got the exception.

Thanks. Now I understand the reason for that exception.
And I know it is no need to manually truncate data.

--   
L.Guo
2007-05-25

-
From: Donald Bruce Stewart
At: 2007-05-25 15:33:46
Subject: Re: [Haskell-cafe] Why this exception occurs ?

dons:
> leaveye.guo:
> > Hi.
> > 
> > In GHCi ver 6.6, why this happens ?
> > 
> > Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> > [0..511]
> > "*** Exception: divide by zero
> 
> It's the use of `rem` on Word8, by the way:
> 
> Prelude> (0 `rem` 256) :: Data.Word.Word8 
> *** Exception: divide by zero
> 

Sorry, I should clarify, think about how to represent:

256 :: Word8

;-)

-- Don

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
dons:
> leaveye.guo:
> > Hi.
> > 
> > In GHCi ver 6.6, why this happens ?
> > 
> > Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> > [0..511]
> > "*** Exception: divide by zero
> 
> It's the use of `rem` on Word8, by the way:
> 
> Prelude> (0 `rem` 256) :: Data.Word.Word8 
> *** Exception: divide by zero
> 

Sorry, I should clarify, think about how to represent:

256 :: Word8

;-)

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
leaveye.guo:
> Hi.
> 
> In GHCi ver 6.6, why this happens ?
> 
> Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> [0..511]
> "*** Exception: divide by zero

It's the use of `rem` on Word8, by the way:

Prelude> (0 `rem` 256) :: Data.Word.Word8 
*** Exception: divide by zero

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
leaveye.guo:
> Hi.
> 
> In GHCi ver 6.6, why this happens ?
> 
> Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> [0..511]
> "*** Exception: divide by zero

Interesting...

Is that just,
Data.ByteString.pack $ [0..255] ++ [0..255]
?

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


[Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread L.Guo
Hi.

In GHCi ver 6.6, why this happens ?

Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
[0..511]
"*** Exception: divide by zero

--
L.Guo
2007-05-25

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