Re: [Haskell-cafe] State of the Hackage: Q1, Q2 2010

2010-07-01 Thread Tim Wawrzynczak
That sounds like an excellent idea!  If you would like some help, let me
know and I would be glad to :)

Cheers,
 - Tim

On Thu, Jul 1, 2010 at 11:50 AM, Don Stewart  wrote:

> I think we need to standardise the presentation of this data, and
> provide a lib to access it.  I'll think some more about it. Should be
> possible to automate it all now (that's mostly done), publish in a known
> location, and provide an API for queries.
>
> inforichland:
> > If anyone wants to see the popularity of their particular package(s),
> dons has
> > kindly left a .txt file with the information
> > at the following URL: 
> > http://code.haskell.org/~dons/hackage/Jun-2010/
> > popular.txt .
> >
> > Of course, this being Haskell, I had to whip up a little script to get
> the
> > information for you.
> >
> > It may not be the most elegant, but it only took a few minutes and it
> does the
> > job.  You'll find it attached :)
> >
> > Cheers,
> >  - Tim
> >
> > On Wed, Jun 30, 2010 at 5:08 PM, Don Stewart  wrote:
> >
> >
> > Downloads and popular packages on Hackage for Q1 and Q2 this year.
> >
> >http://donsbot.wordpress.com/2010/06/30/
> > popular-haskell-packages-q2-2010-report/
> >
> > -- Don
> > ___
> > 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] State of the Hackage: Q1, Q2 2010

2010-06-30 Thread Tim Wawrzynczak
If anyone wants to see the popularity of their particular package(s), dons
has kindly left a .txt file with the information
at the following URL:
http://code.haskell.org/~dons/hackage/Jun-2010/popular.txt .

Of course, this being Haskell, I had to whip up a little script to get the
information for you.

It may not be the most elegant, but it only took a few minutes and it does
the job.  You'll find it attached :)

Cheers,
 - Tim

On Wed, Jun 30, 2010 at 5:08 PM, Don Stewart  wrote:

>
> Downloads and popular packages on Hackage for Q1 and Q2 this year.
>
>
> http://donsbot.wordpress.com/2010/06/30/popular-haskell-packages-q2-2010-report/
>
> -- Don
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


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


Re: [Haskell-cafe] Re: Using the ContT monads for early exits of IO ?

2010-06-10 Thread Tim Wawrzynczak
Or what about a specialized Escape Continuation monad?  (Perhaps there is
one on hackage, not sure).

Something that allows you to set up an continuation (for "escape") purposes,
but does not allow you
to capture any more continuations after that, and call that escape cont w/in
itself, supplying a "return" value.

i.e.

> run = do
>result <- createEscape $ \escape ->
>lengthyComputation1
>inp <- askToContinue
>if (not (continue inp))
>  then escape "They quit"
>  else lengthyComputation2
>return result

Just thinking off the top of my head :).

However, if there are going to be multiple 'lengthy computations' then
perhaps
MaybeT or EitherT would be better, b/c they allow the propagation of failure
across multiple actions, instead of cascading off to the right of the screen
w/ 'if's or 'case's.

Cheers,
 - Tim

On Thu, Jun 10, 2010 at 3:21 PM, Ben Millwood wrote:

> On Thu, Jun 10, 2010 at 8:57 PM, Maciej Piechotka 
> wrote:
> >
> > Error monad seems not to be a semantic solution as we exit on success
> > not failure.
> >
>
> Which is really why the Either monad should not necessarily have Error
> associations :)
> If you forget about the fail method, the Monad (Either e) instance
> doesn't need the e to be an error type.
>
> Alternatively, if even Error is more information than you need, you
> could use MaybeT:
>
> http://hackage.haskell.org/package/MaybeT
>
> which allows you to just stop. Given you're using it with IO it'd be
> easy to write a result to an IORef before terminating the computation,
> so it's of equivalent power, if slightly less convenient.
> ___
> 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] Using the ContT monads for early exits of IO ?

2010-06-10 Thread Tim Wawrzynczak
Actually, on second thought, Lennart is probably right.  Continuations are
probably overkill for this situation.
Since not wanting to continue is probably an 'erroneous condition,' you may
as well use Error.

Cheers,
 - Tim

2010/6/10 Lennart Augustsson 

> I would not use the continuation monad just for early exit.  Sounds
> like the error monad to me.
>
> 2010/6/10 Günther Schmidt :
> > Hi everyone,
> >
> > I'm about to write a rather lengthy piece of IO code. Depending on the
> > results of some of the IO actions I'd like the computation to stop right
> > there and then.
> >
> > Now I know in general how to write this but I'm wondering if this is one
> of
> > those occasions where I should make use of the Cont monad to make an
> early
> > exit.
> >
> > Günther
> >
> > ___
> > 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 mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Using the ContT monads for early exits of IO ?

2010-06-10 Thread Tim Wawrzynczak
Günther,

This is definitely one way to do it.  If you want to be able to "quit" the
IO action in the middle of a lengthy computation, that is one way that I,
personally, find very straightfoward.  You can find an example of this in my
Advgame package on Hackage, which uses this method to quit running the main
action (although I could have used a conditional to determine whether to
continue running the main loop, but continuations are more fun :P).

Small example:

> foo = (`runContT` id) $ do
>dummy <- callCC $ \exit -> forever $ do
>line <- liftIO getLine
>if line == "quit" then exit $ return () else ... -- do whatever
else here...
>

Cheers,
 - Tim

2010/6/10 Günther Schmidt 

> Hi everyone,
>
> I'm about to write a rather lengthy piece of IO code. Depending on the
> results of some of the IO actions I'd like the computation to stop right
> there and then.
>
> Now I know in general how to write this but I'm wondering if this is one of
> those occasions where I should make use of the Cont monad to make an early
> exit.
>
> Günther
>
> ___
> 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] Lazy language on JVM/CLR

2010-02-09 Thread Tim Wawrzynczak
Oops, you're right.  It's not pure.  Mea cupla for not reading more
closely.  I wonder how it deals with I/O, then?  I don't see anything like
Haskell's monads or Clean's uniqueness typing...  but at a closer look it
does appear to have an excellent Java FFI.

On Tue, Feb 9, 2010 at 9:44 AM, Chris Eidhof  wrote:

> I don't think it's pure. I would definitely use a pure language on the JVM,
> but IIRC Open Quark / Cal is an impure language. For example, from the
> library documentation: "printLine :: String -> ()".
>
> -chris
>
> On 9 feb 2010, at 15:31, Tim Wawrzynczak wrote:
>
> > Perhaps this is similar to what you're looking for.
> >
> > http://openquark.org/Open_Quark/Welcome.html
> >
> > It's a pure, lazy language for the JVM.  I haven't used it myself, but I
> would imagine that
> > it would have a Java FFI.
> >
> > Cheers,
> >  - Tim
> >
> > On Mon, Feb 8, 2010 at 6:42 PM, Tony Morris 
> wrote:
> > I have hypothesised a pure, lazy language on the JVM and perhaps the
> > .NET CLR with FFI to .NET/Java libraries. I foresee various problems but
> > none that are catastrophic; just often requiring a compromises,
> > sometimes very unattractive compromises. I have authored several
> > libraries in the same vain as pure, lazy programming to run on the JVM
> > in Java and Scala programming languages.
> >
> > I expect others have forethought and perhaps even experimented with such
> > a language. Are there any dangers to be wary of that undo the entire
> > endeavour?
> >
> > Thanks for any insights.
> >
> > --
> > Tony Morris
> > http://tmorris.net/
> >
> > ___
> > 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 mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Lazy language on JVM/CLR

2010-02-09 Thread Tim Wawrzynczak
Perhaps this is similar to what you're looking for.

http://openquark.org/Open_Quark/Welcome.html

It's a pure, lazy language for the JVM.  I haven't used it myself, but I
would imagine that
it would have a Java FFI.

Cheers,
 - Tim

On Mon, Feb 8, 2010 at 6:42 PM, Tony Morris  wrote:

> I have hypothesised a pure, lazy language on the JVM and perhaps the
> .NET CLR with FFI to .NET/Java libraries. I foresee various problems but
> none that are catastrophic; just often requiring a compromises,
> sometimes very unattractive compromises. I have authored several
> libraries in the same vain as pure, lazy programming to run on the JVM
> in Java and Scala programming languages.
>
> I expect others have forethought and perhaps even experimented with such
> a language. Are there any dangers to be wary of that undo the entire
> endeavour?
>
> Thanks for any insights.
>
> --
> Tony Morris
> http://tmorris.net/
>
> ___
> 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] Parsers for Text Adventures

2010-01-17 Thread Tim Wawrzynczak
Hi Mark,

I recently ported Conrad Barski's 'Casting SPELs in Lisp' to Haskell (a text
adventure game).

I had some of these problems as well, and you can find my code on Hackage
(the package is called Advgame).

Some things in there might be of some help.

Cheers,
 - Tim

On Sun, Jan 17, 2010 at 7:30 AM, Mark Spezzano  wrote:

> Hi,
>
> I am writing a Text Adventure game in Haskell (like Zork)
>
> I have all of the basic parser stuff written as described in Hutton's
> Programming in Haskell and his associated papers. (I'm trying to avoid using
> 3rd party libraries, so that I can learn this myself)
>
> Everything that I have works (so far...) except for the following problem:
>
> I want to define a grammar using a series of Verbs like this:
>
> data Verb = Go | Get | Jump | Climb | Give etc, etc deriving (Show, Read)
>
> and then have my parser "get" one of these Verb tokens if possible;
> otherwise it should do something (?) else like give an error message stating
> "I don't know that command"
>
> Now, Hutton gives examples of parsing strings into string whereas I want to
> parse Strings into my Verbs
>
> So, if the user types "get sword" then it will tokenise "get" as type
> Verb's data constructor Get and perhaps "sword" into a Noun called Sword
>
> My parser is defined like this:
>
> newtype Parser a = Parser (String -> [(a, String)])
>
> So I CAN give it a Verb type
>
> but this is where I run into a problem
>
> I've written a Parser called keyword
>
> keyword :: Parser Verb
> keyword = do x <- many1 letter
>return (read x)
>
> (read this as
> "take-at-least-one-alphabetic-letter-and-convert-to-a-Verb-type")
>
> which DOES work provided that the user types in one of my Verbs. If they
> don't, well, the whole thing fails with an Exception and halts processing,
> returning to GHCi prompt.
>
> Question: Am I going about this the right way? I want to put together lots
> of "data" types like Verb and Noun etc so that I can build a kind of "BNF
> grammar".
>
> Question: If I am going about this the right way then what do I about the
> "read x" bit failing when the user stops typing in a recognised keyword. I
> could catch the exception, but typing an incorrect sentence is just a typo,
> not really appropriate for an exception, I shouldn't think. If it IS
> appropriate to do this in Haskell, then how do I catch this exception and
> continue processing.
>
> I thought that exceptions should be for exceptional circumstances, and it
> would seem that I might be misusing them in this context.
>
> Thanks
>
> Mark Spezzano
>
> ___
> 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] ANNOUNCE: Functional Programming Bibliography

2010-01-14 Thread Tim Wawrzynczak
Oh also, I noticed that you say it's powered by Haskell.

Would you mind sharing some of your architectural details as they relate to
Haskell with us?



On Thu, Jan 14, 2010 at 3:11 PM, Tim Wawrzynczak wrote:

> At a quick glance,
>
> +5 Awesome.
>
> Cheers
> - Tim
>
>
> On Thu, Jan 14, 2010 at 3:03 PM, James Russell wrote:
>
>> I am pleased to announce the Functional Programming Bibliography
>> at http://www.catamorphism.net/
>>
>> The functional programming bibliography was created in the hope
>> that it will be a useful resource to the functional programming
>> community. The site is still in an early stage of development,
>> and is pretty raw, and incomplete in a number of ways. Keyword
>> categorization, in particular, is still fairly spotty.
>>
>> It currently contains in excess of 1500 references, heavily
>> slanted toward Haskell-related topics, and contains links to
>> publicly available versions of many papers, as well as links to
>> gated versions of some papers.
>>
>> I am eager for suggestions as to how the site could be made more
>> useful.
>>
>> Regards,
>>
>> James Russell
>> ___
>> 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] ANNOUNCE: Functional Programming Bibliography

2010-01-14 Thread Tim Wawrzynczak
At a quick glance,

+5 Awesome.

Cheers
- Tim

On Thu, Jan 14, 2010 at 3:03 PM, James Russell wrote:

> I am pleased to announce the Functional Programming Bibliography
> at http://www.catamorphism.net/
>
> The functional programming bibliography was created in the hope
> that it will be a useful resource to the functional programming
> community. The site is still in an early stage of development,
> and is pretty raw, and incomplete in a number of ways. Keyword
> categorization, in particular, is still fairly spotty.
>
> It currently contains in excess of 1500 references, heavily
> slanted toward Haskell-related topics, and contains links to
> publicly available versions of many papers, as well as links to
> gated versions of some papers.
>
> I am eager for suggestions as to how the site could be made more
> useful.
>
> Regards,
>
> James Russell
> ___
> 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] ANN: Advgame 0.1.1

2009-10-31 Thread Tim Wawrzynczak
Hey cafe,

If any of you were (or are) Common Lispers, you may be aware of Dr. Conrad
Barski's humorous and lighthearted
approach to Common Lisp.  As a little tribute to his CL evangelization
efforts, I ported his tutorial,
'Casting SPELs in Lisp' (http://www.lisperati.com/casting.html) to Haskell.
It works very similarly to his final program,
except it can be run in a loop, instead of one function at a time.  It's
available at http://hackage.haskell.org/package/Advgame-0.1.1
if anyone is interested.

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


Re: [Haskell-cafe] AND/OR Perceptron

2009-10-29 Thread Tim Wawrzynczak
Hector,

That line is declaring a function named 'f' of two arguments: one is 'w',
and the other is a tuple.  The tuple's fst is 'inputs', and its snd is
'expected.'  This function (f) is used in the next line, in the declaration
of the list 'newWeights,' which uses f as the function which does the fold
over the allInputs list.

Cheers,
 - Tim

On Thu, Oct 29, 2009 at 2:27 PM, Hector Guilarte wrote:

> Hi cafe,
>
> I'm trying to implement a Perceptron in Haskell and I found one in:
> http://jpmoresmau.blogspot.com/2007/05/perceptron-in-haskell.html (Thanks
> JP Moresmau) but there is one line I don't understand, I was wondering if
> someone could explain it to me. I know the theory behind a perceptron, my
> question is more about the Haskell syntax in that line I don't understand.
>
> epoch :: [([Float],Float)] -> -- ^ Test Cases and Expected Values for each
> test case
>[Float] -> -- ^ weights
>   ([Float],Float) -- ^ New weights, delta
> epoch allInputs weights=
> let
> f w (inputs,expected) = step inputs w expected -- I don't
> understand this line
> newWeights = foldl f weights allInputs -- Neither this one
> delta = (foldl (+) 0 (map abs (zipWith (-) newWeights weights))) /
> (fromIntegral $ length weights)
> in (newWeights,delta)
>
> What is f and what is w? I really don't get it, Is like it is defining a
> function f which calls step unziping the input, taking one of the elements
> from the fst and it's corresponding snd and invoking step with that, along
> with w (which seems to be a list according to step's signature but I don't
> know where it comes from), and then applying fold to the weights and all the
> Inputs using that f function... But I don't get it!
>
> Maybe if someone could rewrite that redefining f as an separate function
> and calling fold with that function I'll get it.
>
> The input for epoch would be something like this:
> epoch [([0,0],0),([0,1],0),([1,0],0),([1,1],1)] [-0,413,0.135]
>
> and the output for that examples is:
> ([0.0,412.9],3.333537e-2)
>
>
> Thanks a lot,
>
> Hector Guilarte
>
> ___
> 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 cannot i get the value of a IORef variable ?

2009-10-22 Thread Tim Wawrzynczak
Well, I apologize for starting this whole thread which involves so many dead
kittens :(  I was just trying to help answer a question :)
I guess I assumed too much.. that someone would think to be careful when
using a function with the word 'unsafe' in it...

So, be warned, all Haskellers!  Be careful when using any function that
starts with the word 'unsafe'!  You may kill a kitten!  And I guess this
says something about using 'unsafe' functions...
http://upload.wikimedia.org/wikipedia/en/1/11/God-kills-kitten.jpg (NSFW)...

Cheers and sorry all,
Tim


On Thu, Oct 22, 2009 at 1:59 PM, Gregory Crosswhite <
gcr...@phys.washington.edu> wrote:

> Yes, I was once taught that "Every time you use unsafePerformIO, God kills
> a kitten,"  so every time I consider using it I first ask myself:  is this
> really worth an innocent kitten's life?
>
> Cheers,
> Greg
>
>
> On Oct 22, 2009, at 11:32 AM, David Menendez wrote:
>
>  On Thu, Oct 22, 2009 at 2:23 AM, Gregory Crosswhite
>>  wrote:
>>
>>> For clarity, one trick that uses "unsafePerformIO" which you may have
>>> seen
>>> posted on this list earlier today is the following way of creating a
>>> globally visible IORef:
>>>
>>> import Data.IORef
>>> import System.IO.Unsafe
>>>
>>> *** counter = unsafePerformIO $ newIORef 0 ***
>>>
>>
>> Danger! If the monomorphism restriction is disabled, this ends up
>> creating a value of type forall a. Num a => IORef a, which can be used
>> to break type safety.
>>
>> More generally,
>>
>> cell :: IORef a
>> cell = unsafePerformIO $ newIORef undefined
>>
>> unsafeCoerce :: a -> b
>> unsafeCoerce x = unsafePerformIO $ do
>>   writeIORef cell x
>>   readIORef cell
>>
>> This way lies segmentation faults. That "unsafe" is there for a reason.
>>
>> --
>> Dave Menendez 
>> >
>>
>
> ___
> 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] Is there a null statement that does nothing?

2009-10-21 Thread Tim Wawrzynczak
Yes, an if statement must have both 'then' and 'else' branches.  As an
example, what if you had

let a = if b == 2 then True else False

and you were missing an else branch?  What would 'a' get assigned to?

The if statement "returns" a value so must have both branches.

However, in a monadic constraint, there are the functions 'when' and
'unless.'  They allow conditional evaluation of expressions in a monadic
context.  For example,

main = do
  line <- getLine
  when (line == "hello") putStrLn "Hello back!"

Cheers,
 - Tim


On Wed, Oct 21, 2009 at 7:43 PM, michael rice  wrote:

> It looks like both the THEN and the ELSE in an IF expression must each have
> an expression. What's a graceful way to do nothing in either or both slots,
> kind of like the Fortran CONTINUE statement.
>
>   --mr
>
> 
>
> [mich...@localhost ~]$ ghci
> GHCi, version 6.10.3: http://www.haskell.org/ghc/  :? for help
> Loading package ghc-prim ... linking ... done.
> Loading package integer ... linking ... done.
> Loading package base ... linking ... done.
> Prelude> if (1==1) then else
>
> :1:15: parse error on input `else'
> Prelude> if (1==1) then True else
>
> :1:24: parse error (possibly incorrect indentation)
> Prelude> if (1==1) then True else False
> True
> Prelude>
>
>
>
> ___
> 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] Simple but interesting (for me) problem

2009-10-21 Thread Tim Wawrzynczak
True...here we go then:

import Data.IORef
import System.IO.Unsafe

mkNext :: (Num a) => IO (IO a)
mkNext = do
  ref <- newIORef 0
  return (do modifyIORef ref (+1)
 readIORef ref)

next :: IO ()
next = do
  foo <- mkNext
  a <- sequence [foo,foo,foo]
  putStrLn $ show a


running next will print [1,2,3] which is the result of calling 'foo' 3
times.

But technically then, mkNext is just an IO action which returns an IO action
;)
and not a function which will return the next value each time it is called,
hence the need to extract the value from mkNext, then use it...

Cheers,
Tim


On Wed, Oct 21, 2009 at 1:30 PM, minh thu  wrote:

> 2009/10/21 Tim Wawrzynczak 
> >
> > Here's an example in the IO monad:
> >
> > import Data.IORef
> > import System.IO.Unsafe
> >
> > counter = unsafePerformIO $ newIORef 0
> >
> > next = do
> >   modifyIORef counter (+1)
> >   readIORef counter
> >
> > Naturally, this uses unsafePerformIO, which as you know, is not kosher...
>
> But you don't close around the Ref like in your schemy example.
>
> mkNext = do
>  ref <- newIORef 0
>  return (do modifyIORef ref succ
> readIORef ref)
>
> mimic your other code better.
>
> Cheers,
> Thu
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Simple but interesting (for me) problem

2009-10-21 Thread Tim Wawrzynczak
Here's an example in the IO monad:

import Data.IORef
import System.IO.Unsafe

counter = unsafePerformIO $ newIORef 0

next = do
  modifyIORef counter (+1)
  readIORef counter

Naturally, this uses unsafePerformIO, which as you know, is not kosher...

Cheers,
 - Tim

On Wed, Oct 21, 2009 at 1:00 PM, Tim Wawrzynczak wrote:

> I'm guessing the function looks something like this? (this is common lisp
> not scheme)
>
> (let ((counter 0))
>   (defun next ()
> (incf counter)
> counter))
>
> So the first time you call (next), it returns 1, then 2, etc.
> The function (next) is a closure over the variable 'counter' and acts by
> incrementing the variable counter, which is only visible in the scope of the
> let-block.  As you know in Haskell there is no mutable state (outside of
> certain monads), so a function like must take place in a monad which allows
> this, such as IO or ST.  You would probably have to allocate an IORef or
> STRef which is local to the next function (effectively creating a closure
> over it).
>
> Cheers,
>  - Tim
>
>
> On Wed, Oct 21, 2009 at 12:34 PM, michael rice  wrote:
>
>>  There's a thread on the plt-scheme list about creating a function of NO
>> arguments named NEXT that just returns the number of times it's been called,
>> a piece of cake in Scheme, but how would one do this in Haskell? Would the
>> best approach be to use a State monad?
>>
>> Michael
>>
>> ___
>> 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] Simple but interesting (for me) problem

2009-10-21 Thread Tim Wawrzynczak
I'm guessing the function looks something like this? (this is common lisp
not scheme)

(let ((counter 0))
  (defun next ()
(incf counter)
counter))

So the first time you call (next), it returns 1, then 2, etc.
The function (next) is a closure over the variable 'counter' and acts by
incrementing the variable counter, which is only visible in the scope of the
let-block.  As you know in Haskell there is no mutable state (outside of
certain monads), so a function like must take place in a monad which allows
this, such as IO or ST.  You would probably have to allocate an IORef or
STRef which is local to the next function (effectively creating a closure
over it).

Cheers,
 - Tim


On Wed, Oct 21, 2009 at 12:34 PM, michael rice  wrote:

> There's a thread on the plt-scheme list about creating a function of NO
> arguments named NEXT that just returns the number of times it's been called,
> a piece of cake in Scheme, but how would one do this in Haskell? Would the
> best approach be to use a State monad?
>
> Michael
>
> ___
> 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] Can this be done?

2009-10-01 Thread Tim Wawrzynczak
I was poking around once trying to find something like that and stumbled
across this: http://wiki.cs.pdx.edu/forge/riviera.html

Cheers,
Tim

On Wed, Feb 11, 2009 at 8:22 AM, Cristiano Paris
wrote:

> I wonder whether this can be done in Haskell (see muleherd's comment):
>
>
> http://www.reddit.com/r/programming/comments/7wi7s/how_continuationbased_web_frameworks_work/
>
> Cristiano
> ___
> 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] Planning for a website

2009-08-18 Thread Tim Wawrzynczak
I'd also give a read to this website:
http://jekor.com/article/is-haskell-a-good-choice-for-web-applications
Interesting read about a guy who actually used Haskell to create his website
from the ground up.


On Tue, Aug 18, 2009 at 9:56 AM, Colin Paul Adams
wrote:

> > "Jake" == Jake McArthur  writes:
>
>Jake> Colin Paul Adams wrote:
>>> One problem will be to get GHC ported to DragonFly BSD, but
>>> that can wait until I have a test version of the site working
>>> on Linux.
>
> Jake> I would love to see this. It's the biggest thing blocking me
>Jake> from trying Dragonfly more seriously.
>
> Well it will happen, as I have to use DragonFly, as my website is all
> about dragonflies :-)
>
> Someone has already got it working sufficiently to compile xmonad, so
> it should just be a matter of digging around the low-level issues.
>
>Jake> You should look into HSP. It also provides those guarantees,
>Jake> is maintained, and provides a nice template-style syntax
>Jake> which you can use inline with your Haskell code.
>
>Jake> Also check out the Formlets library.
>
>>> HappStack is obviously currently maintained, and since it seems
>>> to have a blogging module in development, that is attractive.
>
> Jake> I recommend this.
>
> Thanks.
> --
> Colin Adams
> Preston Lancashire
> ___
> 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] Cont, ContT and IO()

2009-07-03 Thread Tim Wawrzynczak
Well, continuations come from Scheme, and by and large, they are usually
used in languages like Scheme (i.e. PLT web server), or Smalltalk (Seaside
web server), but they can be very useful in e.g. cases like yours for making
a convenient way to make a local exit.  I did this in one toy game program
of mine.  The code looks (somewhat) like this:

run :: GameState ()
run = (`runContT` id) $ do
throwaway <- callCC $ \exit -> forever $ do
-- retrieve the current state
-- get user input, etc...
   case input of
 ...
 "quit" -> exit $ return ()

in this case, when the user enters "quit" the captured continuation is
restored and the value '()' is returned from callCC and assigned to
'throwAway' in this case.

Of course, this is only one use case of continuations, a very powerful
abstraction mechanism :)

Cheers.

2009/7/3 Günther Schmidt 

>
> Hi,
>
> I've got an IO action, some file system IO, traversing one level only and
> iterating over files found. I wish to build in an "early" exit, ie. if an IO
> action in the loop encounters a particular value I want it to abort the
> loop.
>
> Now so far, pls don't shoot, I have done this by throwing IO Exceptions and
> catching them. I'm trying to rewrite this using Continuatios / callCC but
> can't figure out where to place what.
>
> I certainly don't have the intuition yet and funny enough not even in RWH I
> could find some Cont/ContT examples.
>
> Would someone please draw me an example?
>
> Günther
>
> ___
> 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] chr/ord?

2009-04-28 Thread Tim Wawrzynczak
Michael, those functions are not in the Prelude, they're in Data.Char.

On Tue, Apr 28, 2009 at 8:08 PM, michael rice  wrote:

> Hi,
>
> My Prelude docs must be out of date because chr and ord don't seem to be
> there. How do I access these functions?
>
> Michael
>
> ===
>
> [mich...@localhost ~]$ ghci
> GHCi, version 6.10.1: http://www.haskell.org/ghc/  :? for help
> Loading package ghc-prim ... linking ... done.
> Loading package integer ... linking ... done.
> Loading package base ... linking ... done.
> Prelude> chr 65
>
> :1:0: Not in scope: `chr'
> Prelude> ord 'A'
>
> :1:0: Not in scope: `ord'
> Prelude>
>
>
>
>
>
>
> ___
> 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] Overriding a Prelude function?

2009-04-22 Thread Tim Wawrzynczak
You can try at the top
Import Prelude hiding (>>)

On Wed, Apr 22, 2009 at 10:44 AM, michael rice  wrote:

> I've been working through this example from:
> http://en.wikibooks.org/wiki/Haskell/Understanding_monads
>
> I understand what they're doing all the way up to the definition of (>>),
> which duplicates Prelude function (>>). To continue following the example, I
> need to know how to override the Prelude (>>) with the (>>) definition in my
> file rand.hs.
>
> Michael
>
> ==
>
> [mich...@localhost ~]$ cat rand.hs
> import System.Random
>
> type Seed = Int
>
> randomNext :: Seed -> Seed
> randomNext rand = if newRand > 0 then newRand else newRand + 2147483647
> where newRand = 16807 * lo - 2836 * hi
>   (hi,lo) = rand `divMod` 127773
>
> toDieRoll :: Seed -> Int
> toDieRoll seed = (seed `mod` 6) + 1
>
> rollDie :: Seed -> (Int, Seed)
> rollDie seed = ((seed `mod` 6) + 1, randomNext seed)
>
> sumTwoDice :: Seed -> (Int, Seed)
> sumTwoDice seed0 =
>   let (die1, seed1) = rollDie seed0
>   (die2, seed2) = rollDie seed1
>   in (die1 + die2, seed2)
>
> (>>) m n = \seed0 ->
>   let (result1, seed1) = m seed0
>   (result2, seed2) = n seed1
>   in (result2, seed2)
>
> [mich...@localhost ~]$
>
>
>
> ___
> 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] Fwd: [plt-scheme] Vancouver Lisp Users Group meeting for March 2009 - Haskell for Lisp Programmers

2009-02-23 Thread Tim Wawrzynczak
I thought you guys might find this interesting: Haskell for Lisp programmers

-- Forwarded message --
From: Bill Clementson 
Date: Mon, Feb 23, 2009 at 11:12 AM
Subject: [plt-scheme] Vancouver Lisp Users Group meeting for March 2009 -
Haskell for Lisp Programmers
To: undisclosed-recipients


Hi all,

Haskell is a polymorphically statically typed, lazy, purely functional
language based on the lambda calculus. As such, it shares some things
in common with some dialects of Lisp but differs in other regards. Our
March lispvan speaker will present an introduction to Haskell geared
towards Lisp programmers. If you want to read up about Haskell before
the meeting, a good starting point is the Haskell Wiki.

Here's the "official" meeting notice:

Topic: Haskell for Lisp Programmers
Presenter: Erik Charlebois
Date: Wednesday, March 4th, 2009
Time: 7pm - 10pm (or whenever)
Venue: The Hackery, 304 Victoria Dr (entrance off Franklin), Vancouver (see
map)
Summary: Haskell is a lazy, pure, statically-typed functional
programming language enjoying a lot of attention these days. Its
strict approach to side effects is seen as one of the viable
approaches to making parallel programming tractable.

Erik will talk about the core differences between Haskell and Lisp,
the actions the Haskell community is taking to manage this growth, and
some neat applications of the language already in the wild.

* Differences between Haskell and Lisp
 * Syntax
 * Static typing
 * Side effects with monads
* The Haskell Platform
 * Build, Package, Distribute
 * Community
* Haskell Dog and Pony Show

Bio: Erik was a compiler developer for 3 years at IBM working on the
XL Fortran and C/C++ compilers for the Cell processor. He is currently
employed at Slant Six Games doing gameplay programming. For the past 2
years, he has been studying programming languages and databases in a
search for smarter ways to build soft real-time applications like
games.

If possible, I will record the presentation and post it on my blog
after the meeting for those who are unable to attend. Join us for a
beer (bring your own - there's a fridge) and a chance to learn what
static typing and monads are all about!

Any updates will be posted on my blog entry for the meeting:
http://bc.tech.coop/blog/090223.html

--
Bill Clementson
_
 For list-related administrative tasks:
 http://list.cs.brown.edu/mailman/listinfo/plt-scheme
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell Users in the West Michigan Area?

2009-02-11 Thread Tim Wawrzynczak
You should have mentioned this a year ago!  I must moved out of that area
middle of last year...

2009/2/11 John Van Enk 

> I'm wondering if there are people in the West Michigan, USA area who'd be
> interested in forming WMHUG (West Michigan Haskell Users Group).
> Any one on here from that area?
>
> /jve
>
> ___
> 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] some ideas for Haskell', from Python

2009-01-14 Thread Tim Wawrzynczak
On Wed, Jan 14, 2009 at 1:14 PM, Jonathan Cast wrote:

> On Wed, 2009-01-14 at 11:06 -0800, Max Rabkin wrote:
> > On Wed, Jan 14, 2009 at 10:48 AM, Jonathan Cast
> >  wrote:
> > > Do you have an example of
> > > a macro that can't be replaced by higher-order functions and laziness?
> >
> > I believe I do: one macro I found useful when writing a web app in
> > Lisp was something I called hash-bind, which binds variables to the
> > values in a hashtable, with the variable names as keys. For example:
> >
> > (hash-bind (a b) hashtable body)
> > ==
> > (let
> > ((a (lookup hashtable "a"))
> >  (b (lookup hashtable "b"))
> > body)
> >
> > I found this very useful in places where I was given URL request
> > parameters in a hashtable and wanted to extract some variables from
> > it. I don't believe it can be replaced by a higher order function
> > (though I may be wrong).
>
> Thanks!  When you *know* there's a good reason people say something, and
> can't find a good example of *why*, it's a tremendous relief when when
> you find one.  Sort of restores your faith in humanity :)
>
> jcc
>
>
>
I thought of another good case (Shamelessly stolen from Paul Graham's 'On
Lisp').  When defining a function to average the results of the list, you
could define avg like this:

(defun avg (&rest args)
  (/ (apply #'+ args) (length args)))

Or as a macro like this:

(defmacro avg (&rest args)
  `(/ (+ ,@args) ,(length args)))

The reason the macro is better is that the length of the list is known at
compile time, so you don't need to traverse the list to calculate the length
of the list.

Food for thought, anyway.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] some ideas for Haskell', from Python

2009-01-14 Thread Tim Wawrzynczak
On Wed, Jan 14, 2009 at 12:56 PM, Martijn van Steenbergen <
mart...@van.steenbergen.nl> wrote:

> Jonathan Cast wrote:
>
>> Haskell already has a couple of abstraction tools for dealing with code.
>> One is called `first-class functions'; another is called `lazy
>> evaluation'.
>>
>
> And for all the rest there is TH?
>
> M.
>
>
Woah fellas, I wasn't trying to start a flame war, I was merely commenting
that those who have not used Lisp don't really understand the power that
macros can have in a language (such as Lisp) that supports them, and where
code and data can be used interchangeably.  And I've never used TH so I
can't comment on that.  Don't worry, I'm on your side :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] some ideas for Haskell', from Python

2009-01-14 Thread Tim Wawrzynczak
>
> You're probably right.
> I've played around with LISP macros a little, but it seems that most
> of the cases where you would use a macro in LISP you don't need one in
> haskell due to lazy evaluation.  Although I haven't played around with
> them enough to say much one way or another.
>
> Do you know of a particular example where a macro would be a big help
> in haskell?
>

Well, like many good programming tools, Lisp macros are another abstraction,
but instead of dealing with data, they deal with code.  They are a syntactic
abstraction.  They're often described as "programs that write programs."  We
all know how much Haskell likes abstractions ;)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] some ideas for Haskell', from Python

2009-01-14 Thread Tim Wawrzynczak
Having an import/module feature like this would replace almost all cases
> where someone might wish for a macro system for Haskell.
>

Don't say that until you've tried Lisp macros... read some of Paul Graham's
essays or try some Common Lisp for yourself... macros can be an incredibly
powerful tool, but "macros" from C, etc. aren't really macros, they're more
like find-and-replace expressions :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Dr Dobbs: Time to get good at functional programming

2008-12-07 Thread Tim Wawrzynczak
Amen to that.  People who haven't really given a fair look at functional
langauges (Haskell in particular) seem to have a very poor conception of
them.  Again, this seems to especially be a problem with Haskell (i.e., the
whole "monads are hard" thing)... If this is where people are getting their
information from, it would definitely behoove the Haskell community to
update its image to further Haskell and FP in general :)



On Sun, Dec 7, 2008 at 12:11 PM, Don Stewart <[EMAIL PROTECTED]> wrote:

> jason.dusek:
> >   Too bad they didn't pimp Haskell as practical.
>
> It looked like an archaic view of Haskell based on reading wikipedia,
> imo. Perhaps we should take charge of the wikipedia page, if it is that
> influential.
> ___
> 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