Re: [Haskell-cafe] Looking for numbers to support using haskell

2013-09-23 Thread Eric Rasmussen
Hi Nick,

FP Complete has a lot of good resources on this topic, including some case
studies: https://www.fpcomplete.com/business/resources/case-studies/

I believe part of their aim is making the business case for Haskell
(meaning many of the resources are geared towards management), which I
realize is not exactly what you asked for. But hopefully you'll find
something there that can help.

Best,
Eric



On Mon, Sep 23, 2013 at 12:13 PM, Nick Vanderweit nick.vanderw...@gmail.com
 wrote:

 I'd be interested in more studies in this space. Does anyone know of
 empirical studies on program robustness vs. other languages?


 Nick

 On 09/23/2013 11:31 AM, MigMit wrote:
  The classical reference is, I think, the paper “Haskell vs. Ada vs. C++
 vs. Awk vs. ... An Experiment in Software Prototyping Productivity”
 
  On Sep 23, 2013, at 9:20 PM, Mike Meyer m...@mired.org wrote:
 
  Hi all,
 
  I'm looking for articles that provide some technical support for why
 Haskell rocks. Not just cheerleading, but something with a bit of real
 information in it - a comparison of code snippets in multiple languages, or
 the results of a study on programmer productivity (given all the noise and
 heat on the topic of type checking, surely there's a study somewhere that
 actually provides light as well), etc.
 
  Basically, I'd love things that would turn into an elevator pitch of I
 can show you how to be X times more productive than you are using Y, and
 then the article provides the evidence to support that claim.
 
  Thanks,
  Mike
  ___
  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


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


Re: [Haskell-cafe] function arithmetic?

2013-09-01 Thread Eric Rasmussen
Might not be exactly what you're looking for, but Control.Arrow has a rich
set of operators that can be used to combine functions.

For instance, there's an example on
http://en.wikibooks.org/wiki/Haskell/Understanding_arrows showing an addA
function that can be used to apply two functions to the same argument and
add the results:

Prelude import Control.Arrow
Prelude Control.Arrow let addA f g = f  g  arr (\ (y, z) - y + z)
Prelude Control.Arrow addA (+2) (*5) 10
62

If you're set on using the + and * operators, I'm guessing it's not
possible to define a (sane) instance of Num for (-), but it would probably
be instructive to try.



On Sat, Aug 31, 2013 at 10:01 PM, Christopher Howard 
christopher.how...@frigidcode.com wrote:

 Hi. I was just curious about something. In one of my math textbooks I see
 expressions like this

 f + g

 or

 (f + g)(a)

 where f and g are functions. What is meant is

 f(a) + g(a)

 Is there a way in Haskell you can make use of syntax like that (i.e.,
 expressions like f + g and f * g to create a new function), perhaps by
 loading a module or something?

 __**_
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://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] catching IO errors in a monad transformer stack

2013-07-22 Thread Eric Rasmussen
Thanks John. I'll try it out, along with Kmett's exceptions package I just
found:

http://hackage.haskell.org/packages/archive/exceptions/0.1.1/doc/html/Control-Monad-Catch.html

I noticed on an issue for lens (https://github.com/ekmett/lens/issues/301)
they switched to this since MonadCatchIO is deprecated, and it has a more
general version of catch:

  catch :: Exception e = m a - (e - m a) - m a






On Sun, Jul 21, 2013 at 6:30 PM, John Lato jwl...@gmail.com wrote:

 I think most people use monad-control these days for catching exceptions
 in monad stacks (http://hackage.haskell.org/package/monad-control-0.3.2.1).
  The very convenient lifted-base package (
 http://hackage.haskell.org/package/lifted-base) depends on it and exports
 a function Control.Exception.Lifted.catch:

 Control.Exception.Lifted.catch :: (MonadBaseControl IO m, Exception e)
   = m a - (e - m a) - m a

 I'd recommend you use that instead of MonadCatchIO.


 On Mon, Jul 22, 2013 at 4:13 AM, Eric Rasmussen 
 ericrasmus...@gmail.comwrote:

 Arie,

 Thanks for calling that out. The most useful part for my case is the
 MonadCatchIO implementation of catch:

 catch :: Exception e = m a - (e - m a) - m a

 Hoogle shows a few similar functions for that type signature, but they
 won't work for the case of catching an IOException in an arbitrary monad.
 Do you happen to know of another approach for catching IOExceptions and
 throwing them in ErrorT?

 Thanks,
 Eric






 On Sun, Jul 21, 2013 at 7:00 AM, Arie Peterson ar...@xs4all.nl wrote:

 On Thursday 18 July 2013 23:05:33 Eric Rasmussen wrote:
  […]
  Would there be any interest in cleaning that up and adding it (or
 something
  similar) to Control.Monad.CatchIO?
  […]

 MonadCatchIO-transformers is being deprecated, as recently GHC has
 removed the
 'block' and 'unblock' functions, rendering the api provided by
 Control.Monad.CatchIO obsolete.


 Regards,

 Arie


 ___
 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] catching IO errors in a monad transformer stack

2013-07-21 Thread Eric Rasmussen
Arie,

Thanks for calling that out. The most useful part for my case is the
MonadCatchIO implementation of catch:

catch :: Exception e = m a - (e - m a) - m a

Hoogle shows a few similar functions for that type signature, but they
won't work for the case of catching an IOException in an arbitrary monad.
Do you happen to know of another approach for catching IOExceptions and
throwing them in ErrorT?

Thanks,
Eric






On Sun, Jul 21, 2013 at 7:00 AM, Arie Peterson ar...@xs4all.nl wrote:

 On Thursday 18 July 2013 23:05:33 Eric Rasmussen wrote:
  […]
  Would there be any interest in cleaning that up and adding it (or
 something
  similar) to Control.Monad.CatchIO?
  […]

 MonadCatchIO-transformers is being deprecated, as recently GHC has removed
 the
 'block' and 'unblock' functions, rendering the api provided by
 Control.Monad.CatchIO obsolete.


 Regards,

 Arie


 ___
 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] List Monads and non-determinism

2013-07-20 Thread Eric Rasmussen
For the sake of approaching this in yet another way, it can also be helpful
to substitute the definitions of bind and return in your expression. If we
start with the definitions:

instance Monad [] where
  xs = f = concat (map f xs)
  return x = [x]

Then we can make the following transformations:

  [1,2] = \n - [3,4] = \m - return (n,m)

  [1,2] = \n - [3,4] = \m - [(n, m)]

  [1,2] = \n - concat (map (\m - [(n, m)]) [3,4])

  concat (map (\n - concat (map (\m - [(n, m)]) [3,4])) [1,2])

Or perhaps more simply:

  concatMap (\n - concatMap (\m - [(n, m)]) [3,4]) [1,2]

All of which are valid expressions and produce the same value.

Depending on your learning style this might not be as helpful as the other
approaches, but it does take a lot of the mystery out of = and return.






On Sat, Jul 20, 2013 at 1:08 AM, Alberto G. Corona agocor...@gmail.comwrote:

 Matt

 It is not return, but the bind the one that does the miracle of
 multiplication.
 By its definition for the list monad, it applies the second term once for
 each element are in the first term.
 So return is called many times. At the end, bind concat all the small
 lists generated


 2013/7/20 Matt Ford m...@dancingfrog.co.uk

 Hi All,

 I thought I'd have a go at destructing

 [1,2] = \n - [3,4] = \m - return (n,m)

 which results in [(1,3)(1,4),(2,3),(2,4)]

 I started by putting brackets in

 ([1,2] = \n - [3,4]) = \m - return (n,m)

 This immediately fails when evaluated: I expect it's something to do
 with the n value now not being seen by the final return.

 It seems to me that the return function is doing something more than
 it's definition (return x = [x]).

 If ignore the error introduced by the brackets I have and continue to
 simplify I get.

 [3,4,3,4] = \m - return (n,m)

 Now this obviously won't work as there is no 'n' value.  So what's
 happening here? Return seems to be doing way more work than lifting the
 result to a list, how does Haskell know to do this?  Why's it not in the
 function definition?  Are lists somehow a special case?

 Any pointers appreciated.

 Cheers,

 --
 Matt

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




 --
 Alberto.

 ___
 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] catching IO errors in a monad transformer stack

2013-07-19 Thread Eric Rasmussen
Thanks Alberto!

I was able to derive MonadCatchIO for my stack and generalize my IO error
handling to:

{-# LANGUAGE FlexibleContexts #-}

import Prelude hiding (catch)

import Control.Monad.Error
import Control.Monad.State
import Control.Monad.CatchIO

import System.IO.Error (tryIOError)
import Control.Exception (IOException)

guardIO :: (MonadCatchIO m, MonadError String m) = IO a - m a
guardIO action =
  liftIO action `catch` \e - throwError $ show (e :: IOException)

As David mentioned it can be better to leave this to the individual, but it
seems like it would be fairly common to want a drop-in replacement for
liftIO that would automatically handle IO exceptions using ErrorT instead
of breaking the flow of the program or requiring the developer to catch
everything separately.

My example above might be too specific because not everyone will represent
errors with String when using ErrorT, but we could accommodate that with:

guardIO' :: (MonadCatchIO m, MonadError e m) = IO a - (IOException - e)
- m a
guardIO' action convertExc =
  liftIO action `catch` \e - throwError $ convertExc e

Would there be any interest in cleaning that up and adding it (or something
similar) to Control.Monad.CatchIO?

Either way I will write up a blog post on it since I couldn't find any
tutorials breaking this process down.

Thanks everyone!








On Thu, Jul 18, 2013 at 4:23 PM, Alberto G. Corona agocor...@gmail.comwrote:

 Hi Eric:

 The pattern may be the MonadCatchIO class:

 http://hackage.haskell.org/package/MonadCatchIO-transformers


 2013/7/18 Eric Rasmussen ericrasmus...@gmail.com

 Hello,

 I am writing a small application that uses a monad transformer stack, and
 I'm looking for advice on the best way to handle IO errors. Ideally I'd
 like to be able to perform an action (such as readFile
 file_that_does_not_exist), catch the IOError, and then convert it to a
 string error in MonadError. Here's an example of what I'm doing now:

 {-# LANGUAGE FlexibleContexts #-}

 import Control.Monad.Error
 import Control.Monad.State

 import System.IO.Error (tryIOError)

 catcher :: (MonadIO m, MonadError String m) = IO a - m a
 catcher action = do
   result - liftIO $ tryIOError action
   case result of
 Left  e - throwError (show e)
 Right r - return r

 This does work as expected, but I get the nagging feeling that I'm
 missing an underlying pattern here. I have tried catch, catchError, and
 several others, but (unless I misused them) they don't actually help here.
 The tryIOError function from System.IO.Error is the most helpful, but I
 still have to manually inspect the result to throwError or return to my
 underlying monad.

 Since this has come up for me a few times now, I welcome any advice or
 suggestions on alternative approaches or whether this functionality already
 exists somewhere.

 Thanks!
 Eric






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




 --
 Alberto.

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


[Haskell-cafe] catching IO errors in a monad transformer stack

2013-07-18 Thread Eric Rasmussen
Hello,

I am writing a small application that uses a monad transformer stack, and
I'm looking for advice on the best way to handle IO errors. Ideally I'd
like to be able to perform an action (such as readFile
file_that_does_not_exist), catch the IOError, and then convert it to a
string error in MonadError. Here's an example of what I'm doing now:

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.Error
import Control.Monad.State

import System.IO.Error (tryIOError)

catcher :: (MonadIO m, MonadError String m) = IO a - m a
catcher action = do
  result - liftIO $ tryIOError action
  case result of
Left  e - throwError (show e)
Right r - return r

This does work as expected, but I get the nagging feeling that I'm missing
an underlying pattern here. I have tried catch, catchError, and several
others, but (unless I misused them) they don't actually help here. The
tryIOError function from System.IO.Error is the most helpful, but I still
have to manually inspect the result to throwError or return to my
underlying monad.

Since this has come up for me a few times now, I welcome any advice or
suggestions on alternative approaches or whether this functionality already
exists somewhere.

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


Re: [Haskell-cafe] [extension]syntactic sugar for maps

2013-03-27 Thread Eric Rasmussen
I agree that fromList or pattern matching at the function or case level are
readable. We probably don't need new sugar. For what it's worth, in scala
you can use - to construct tuples, so you'll sometimes see maps created
like this:

Map(1 - one, 2 - two, 3 - foo)

You can always do something similar in haskell (keeping in mind that -
is reserved):

import qualified Data.Map as Map

(--) = (,)

makeMap = Map.fromList

myMap = makeMap [ 1 -- one
, 2 -- two
, 3 -- foo
]

Of course, it's not idiomatic and won't be immediately obvious to readers
that you are constructing tuples. However, if you find it easier to read
and need to write a lot of map literals in your code, it may be worth
coming up with a couple of aliases similar to those.


On Wed, Mar 27, 2013 at 1:16 PM, Eli Frey eli.lee.f...@gmail.com wrote:

  Sorry, I forgot to explain (probably because I'm too used to it). I am
 referring to a syntax for easy creation of maps. Something equivalent to
 lists:
 
  to build a list: [ 1, 2, 3]
  to build a map; { 1, one, 2, two, 3, three}
 
  Without it I am always forced to use fromList.

 This looks like something to use records for, or in any case something
 where association list performance is not an issue.

 If you just want to store some configuration-like structure and pass it
 around, a record is great for this.  You might find where in other
 languages you would simply leave a key null, in Haskell you can just fill
 it with a Nothing.

 Maps (hash or binary-tree) really pay off when they are filled dynamically
 with massive numbers of associations.  I find when I am ending up in this
 scenario, I am generating my map programatically, not writing it as a
 literal.

 Sometimes people even write maps simply as functions and not even as a
 data-structure.

  myMap char = case char of
  'a' - 1
  'b' - 2
  'c' - 3

 Perhaps you could describe a situation you are in where you are wanting
 this, and we could see if there is something you can do already that is
 satisfying and solves your problem.



 On Wed, Mar 27, 2013 at 12:59 PM, Eli Frey eli.lee.f...@gmail.com wrote:

  http://hackage.haskell.org/trac/ghc/wiki/OverloadedLists comes to mind.

 This assumes you can turn ANY list into a thing.  Maps only make sense to
 be constructed from association list.  If I've got a [Char], how do I make
 a map form it?


 On Wed, Mar 27, 2013 at 12:56 PM, Nicolas Trangez 
 nico...@incubaid.comwrote:

 On Wed, 2013-03-27 at 21:30 +0200, Răzvan Rotaru wrote:
  I am terribly missing some syntactic sugar for maps (associative data
  structures) in Haskell. I find myself using them more than any other
  data
  structure, and I think there is no big deal in adding some sugar for
  this
  to the language. I could not find out whether such an extension is
  beeing
  discussed. If not, I would like to propose and extension. Any help and
  suggestions are very welcome here. Thanks.

 http://hackage.haskell.org/trac/ghc/wiki/OverloadedLists comes to mind.

 Nicolas


 ___
 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] Object Oriented programming for Functional Programmers

2012-12-30 Thread Eric Rasmussen
Since no one's mentioned it yet, you might consider learning Scala. A good
starting point is http://www.artima.com/pins1ed/index.html (note that the
free edition is outdated but still a good introduction).

Scala has a mix of functional and OO programming styles, though (having
come first from Haskell) I'd say it favors the OO side. If you approach it
as OO with some nice functional touches (higher level list operations,
immutability, recursively defined data structures, and pattern matching),
it can be very fun to work with.

Scala's type system is also more expressive than the other OO languages
I've worked with, which is a big plus if you're coming from Haskell.
Learning about subtyping and variance annotations via Scala gives you tools
for reasoning about objects that you won't get from dynamically typed OO
languages.

On Sun, Dec 30, 2012 at 6:12 PM, Jay Sulzberger j...@panix.com wrote:



 On Mon, 31 Dec 2012, MigMit miguelim...@yandex.ru wrote:

  Well, functional programmer is a relatively broad term. If
 you're coming from academia, so that for you Haskell is some
 sort of lambda-calculus, spoiled by practical aspects, then I'd
 suggest Luca Cardelli's book Theory of Objects.

 Also, as Daniel told you already, don't start from C++, it


 Name typo, should be Jay, noted.


  really has very little to do with OOP. It's primary merit is a
 very powerful system of macros (called templates in C++
 world), not objects. If you want something mainstream, Java
 would be a good choice, and C# even better one (although it
 would be more convenient for you if you use Windows).

 Or you can try OCaml, which is functional enough for you not to
 feel lost, and object-oriented as well.

 Отправлено с iPad


 For systems to look at I recommend Simula, some early version,
 Smalltalk, Common Lisp, and Erlang.  My guess is that Haskell's
 type classes are a mechanism for creating something like Common
 Lisp's generic functions.  I know too little about Haskell to
 say whether type classes immediately give you single dispatch
 things, or multiple dispatch things.

 These two Wikipedia articles are useful, I think:

   
 http://en.wikipedia.org/wiki/**Generic_functionhttp://en.wikipedia.org/wiki/Generic_function
   [page was last modified on 15 November 2012 at 03:50]

   
 http://en.wikipedia.org/wiki/**Common_Lisp_Object_Systemhttp://en.wikipedia.org/wiki/Common_Lisp_Object_System
   [page was last modified on 15 December 2012 at 23:57]

 The Diamond Problem and its cousin(s) are worth looking at:

   
 http://en.wikipedia.org/wiki/**Diamond_problem#The_diamond_**problemhttp://en.wikipedia.org/wiki/Diamond_problem#The_diamond_problem
   [page was last modified on 27 December 2012 at 04:53]

   
 http://www.ibm.com/**developerworks/java/library/j-**clojure-protocols/http://www.ibm.com/developerworks/java/library/j-clojure-protocols/

   http://stackoverflow.com/**questions/4509782/simple-**
 explanation-of-clojure-**protocolshttp://stackoverflow.com/questions/4509782/simple-explanation-of-clojure-protocols

 oo--JS.




 30.12.2012, в 23:58, Daniel Díaz Casanueva dhelta.d...@gmail.com
 написал(а):

  Hello, Haskell Cafe folks.

 My programming life (which has started about 3-4 years ago) has always
 been in the functional paradigm. Eventually, I had to program in Pascal and
 Prolog for my University (where I learned Haskell). I also did some PHP,
 SQL and HTML while building some web sites, languages that I taught to
 myself. I have never had any contact with JavaScript though.
 But all these languages were in my life as secondary languages, being
 Haskell my predominant preference. Haskell was the first programming
 language I learned, and subsequent languages never seemed so natural and
 worthwhile to me. In fact, every time I had to use another language, I
 created a combinator library in Haskell to write it (this was the reason
 that brought me to start with the HaTeX library). Of course, this practice
 wasn't always the best approach.

 But, why I am writing this to you, haskellers?

 Well, my curiosity is bringing me to learn a new general purpose
 programming language. Haskellers are frequently comparing Object-Oriented
 languages with Haskell itself, but I have never programmed in any
 OO-language! (perhaps this is an uncommon case) I thought it could be good
 to me (as a programmer) to learn C/C++. Many interesting courses (most of
 them) use these languages and I feel like limited for being a Haskell
 programmer. It looks like I have to learn imperative programming (with side
 effects all over around) in some point of my programming life.

 So my questions for you all are:

 * Is it really worthwhile for me to learn OO-programming?

 * If so, where should I start? There are plenty of functional
 programming for OO programmers but I have never seen OO programming for
 functional programmers.

 * Is it true that learning other programming languages leads to a better
 use of your favorite programming 

Re: [Haskell-cafe] Teaching Haskell @ MOOCs like Coursera or Udacity

2012-10-24 Thread Eric Rasmussen
I can see that the required effort would be prohibitive, but after thinking
about this some more I do think there are a couple of nice advantages:

1) Quizzes and graded assignments offer some structure to self study, and
having some form of feedback/validation when you first get started is
helpful. I learned a lot of Haskell by making up my own assignments, but
not everyone is willing to put that kind of time into it.

2) I know several developers with great engineering skills who are taking
the Scala course because it gives them a structured way to get into it and
have something to show for the time on their resume. They're busy
professionals whose skills and expertise in large projects could really
benefit the Haskell community, but I've had no luck convincing them that
it's worth the time spent researching and learning on their own.

Scala already has some appeal for them if they have to work with java code
or have spent years with object oriented programming, so I think the more
the Haskell community can do to bring them here, the better.

Whether or not it's feasible to create the course is another issue. I don't
have an academic background or any academic affiliations to get the ball
rolling, but if anyone wants to make a course I'll volunteer to help proof
materials, test quizzes and assignments, and work on utilities to submit
and grade assignments.

On Tue, Oct 23, 2012 at 7:02 AM, Brent Yorgey byor...@seas.upenn.eduwrote:

 On Thu, Oct 18, 2012 at 11:49:08PM +0530, niket wrote:
  I am a novice in Haskell but I would love to see the gurus out here
  teaching Haskell on MOOCs like Coursera or Udacity.
 
  Dr Martin Odersky is doing it for Scala here:
  https://www.coursera.org/course/progfun
 
  I would love to see Haskell growing on such new platforms!

 Just as a counterpoint, putting together a MOOC is a *ton* of work,
 with (in my opinion) not much benefit for a topic like Haskell where
 it is already possible to access lots of quality instructional
 materials online.  I would rather see Haskell gurus put their time and
 effort into producing more awesome code (or into curating existing
 instructional materials).

 Just my 2c.

 -Brent

 ___
 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] Am I the only one having problems with RWH?

2012-10-06 Thread Eric Rasmussen
I found I had to keep switching between RWH and other books for these
concepts to sink in. A really good resource that I don't see mentioned too
often is the Haskell wikibook:

http://en.wikibooks.org/wiki/Haskell

I don't remember it covering parsec specifically but if you get grounded in
all the concepts there, the RWH chapters on parsec will make more sense. It
also helped me to take breaks from RWH and re-read chapters later.

Also if you find yourself getting discouraged, I really like Brent Yorgey's
article on the monad tutorial fallacy:
http://byorgey.wordpress.com/2009/01/12/abstraction-intuition-and-the-monad-tutorial-fallacy/

It uses monads as an example but describes the process of learning
difficult concepts.

On Sat, Oct 6, 2012 at 12:54 PM, Janek S. fremenz...@poczta.onet.pl wrote:

 Dnia sobota, 6 października 2012, Mark Thom napisał:
 Also, the functional pearl on applicative functors by Conor McBride and a
 second
  author (can't recall his name) blew the door open on the subject, for me.
 Good to hear, it's in front of me on the desk and I'm planning to finish
 that pearl tomorrow (BTW.
 Ross Paterson is the second author).

  I'm not totally sure if you're having problems with RWH, or think it's
  too easy, but here are my thoughts on both:
 I consider RWH to be a bit too hard for me.

   I too agree that LYAH is the
  easier one, and it is slightly more focused on the theory and concepts
  of Haskell, so I would definitely recommend checking that out.
 I already read LYAH.

  For other Haskell-related writings, Simon Marlow is currently writing
  a book based on his Parallel and Concurrent Programming in Haskell
  tutorial (http://community.haskell.org/~simonmar/par-tutorial.pdf) for
  O'Reilly at the moment. In the meantime, I've found the Simons' papers
  to be interesting reading:
 Yes, I know about the upcomming book and I'm awaiting it. Right now I'm
 digging through REPA
 papers, but Marlow's tutorial is next on my list of things to read.

  So, you're probably at a level where you'll want to start looking for
  interesting academical papers on Haskell/FP and theory, then re-visit
  RWH once in a while
 Well, I figured out that before I go into more academic stuff I should
 have more knowledge about
 the basics, which I thought would be covered by RWH. Hence my frustration
 from not understanding
 a book that's supposed to introduce people to Haskell.

 I guess I'll start with reading some papers on parallelism and go back to
 RWH when I have more
 experience.

 Jan

 ___
 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] A functional programming solution for Mr and Mrs Hollingberry

2012-05-29 Thread Eric Rasmussen
I added a Scala solution since Haskell is already well represented.

Regarding exercises that are easier in OO, I don't think you'll find one
that a good Haskell programmer can't match in a functional style. But if
you make simulation the goal of the exercise (rather than writing a program
that takes input and produces the correct output however it likes), you'll
get a nice compare/contrast of OO and non-OO approaches.

One idea (contrived and silly though it is) is modeling a Courier that
delivers message to Persons. There is a standard default reply for all
Persons, some individuals have their own default reply, and there are
conditional replies based on the sender. Each reply has the ability to
alter a Person's mood. The goal of the exercise would be to read in a CSV
file in the form of To, From, Message, and then output the interactions
based on rules. A sample run might look like:

Courier delivers let's have lunch from Susan to Joe
Joe replies Thanks for the message!
Courier delivers how's your day? from Joe's Best Friend to Joe
Joe replies Hey Best Friend, thanks for the message!
Joe's mood changes from normal to happy

This would be a trivial exercise for any OO programmer, and I suspect
solutions in different OO languages would look pretty much the same. But in
pure functional programming there are more choices to make (particularly
the choice of data structures and types), so you might see a wider range of
creative approaches.


On Sun, May 27, 2012 at 8:21 PM, Alexander Solla alex.so...@gmail.comwrote:



 On Sun, May 27, 2012 at 7:07 PM, Richard O'Keefe o...@cs.otago.ac.nzwrote:


 On 26/05/2012, at 4:16 AM, David Turner wrote:
 
  I don't. I think the trouble is that classes don't add value in
 exercises of this size.

 This was the key point, I think.
 In this example, there wasn't any significant behaviour that could be
 moved
 to superclasses.  For that matter, whether a supplier is plain, preferred,
 or problematic is, one hopes, not a *permanent* property of a supplier.

 Sometimes higher-order functions can substitute for classes.


 Functors can always substitute for OO classes.  A class system is a
 functor from the set of objects to a set of methods, mediated by
 inheritance, or things like message-passing, duck typing, prototyping, etc.

 Functions with the type Foo - Foo can be easily used to implement a
 prototype based dispatch mechanism.  Indeed, this is a common Haskell
 pattern.  Define:

 -- Library code:
 defaultFoo :: Foo
 defaultFoo = Foo { bar =  ..., baz = ... }

 -- Client code
 myFoo = defaultFoo { bar = myBar }

 Things can get as complicated as you would like, up to and including
 inheritance, by using functors other than ((-) a)

 The defining characteristic of OO is that objects are stateful, but
 self-contained entities.  How methods are defined and dispatched vary
 wildly across OO languages.

 ___
 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] Please critique my code (a simple lexer)

2012-05-22 Thread Eric Rasmussen
Another suggestion is to use pattern matching at the function level:

doLex' lexer loc [] = [makeToken EOF]
doLex' lexer loc (x:xs) = case x of
' ' - more (locInc loc 1) xs
'\n'- more (locNL loc) xs
...
_  -

That saves you from having to deconstruct repeatedly in your case
statements.

You might also want to check out the excellent HLint (available on
hackage), which will give you even more suggestions.

On Tue, May 22, 2012 at 8:36 AM, Taylor Hedberg t...@tmh.cc wrote:

 John Simon, Tue 2012-05-22 @ 10:13:07-0500:
  - My `consume` function seems basic enough that it should be library
  code, but my searches turned up empty. Did I miss anything?

 consume = span . flip elem


  - Is creating data structures with simple field names like `kind`,
  `offset`, etc a good practice? Since the names are global functions, I
  worry about namespace pollution, or stomping on functions defined
  elsewhere.

 If you don't intend your module to be imported and used as a library,
 then there's no reason to worry about this. If you do intend it to be
 used that way, then it's probably still not worth worrying about, as
 name clashes can be resolved at the import level via qualified imports
 or `hiding` lists. If it ends up really being a problem, you can always
 add a namespace prefix to those names, though honestly I find that kind
 of ugly.

 The compiler will always catch cases of ambiguity caused by multiple
 definitions of the same name being in scope, so you don't have to worry
 about this causing inadvertent runtime bugs.

 ___
 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] Parsing binary data question

2011-09-28 Thread Eric Rasmussen
Hi Michael,

I recommend Attoparsec when parsing raw data into custom data types.
There aren't as many examples and tutorials as there are for Parsec,
but the API is very similar, and some of the important differences are
listed on Attoparsec's Hackage entry. There are also helpful examples
of its usage here:
https://bitbucket.org/bos/attoparsec/src/286c3d520c52/examples/

Take care,
Eric


On Tue, Sep 27, 2011 at 2:14 AM, Michael Oswald muell...@gmx.net wrote:
 Hello all,

 I am currently working on parser for some packets received via the network.
 The data structure currently is like that:


 data Value = ValUInt8 Int8
           | ValUInt16 Int16
           | ValUInt32 Int32
        -- more datatypes

 data Parameter = Parameter {
  paramName :: String,
  paramValue :: Value
  }
  | ParameterN {
  paramName :: String,
  paramValue :: Value
  }deriving (Show)

 data TCPacket = TCPacket {
  tcAPID :: Word16,
  tcType :: Word8,
  tcSubType :: Word8,
  tcParameters :: [Parameter]
  }

 The output should a parsed packet (I am using cereal for this). The packet
 structure can vary depending on the type and the configuration, so I have a
 function which takes a TCPacket as input template which has already the
 correct list of parameters which are then parsed:

 parseTCPacket :: Word16 - Word8 - Word8 - ByteString - TCPacket -
 TCPacket
 parseTCPacket apid t st pktData tmplate =
    TCPacket apid t st params
    where
        tmplParams = (tcParameters tmplate)
        params = zipWith (\p v - p {paramValue = v} ) tmplParams values'
        values = map paramValue tmplParams
        values' = binValues values (pktData pusPkt)

 getBinGet :: Value - Get Value
 getBinGet (ValInt8 _) = getWord8 = \x - return $ ValInt8 $ fromIntegral x
 getBinGet (ValInt16 _) = getWord16be = \x - return $ ValInt16 $
 fromIntegral x
 -- many more datatypes

 getBinValues :: [Value] - Get [Value]
 getBinValues inp = mapM getBinGet inp


 binValues :: [Value] - ByteString - ([Value], B.ByteString)
 binValues inp bytes = case runGet (getBinValues inp) bytes of
                        Left err - throw $ DecodeError (binValues:  ++
 err)
                        Right x - x


 This works quite well and does what I want. Now I have the problem that
 there are some parameters, which could be so-called group repeaters (the
 ParameterN constructor above). This means, that if such a parameter N is
 encountered during parsing (it has to be an int type), all following
 parameters are repeated N times with possible nesting.

 So for example if the template (where the values are all 0) is like this:
 [Parameter Param1 (ValUInt32 0), ParameterN N1 (ValUInt8 0), Parameter
 Param2 (ValUint16 0), ParameterN N2 (ValUint8 0),
 Parameter Param3 (ValUint8 0)]

 Which means there is a group for the last 3 parameters which is repeated N1
 times which contains another group which is repeated N2 times.
 If binary data based on the template above would be like this (datatypes
 omitted):

 10, 2, 439, 2, 12, 13, 65535, 2, 22, 23

 then a valid packet after parsing would be:

 [Parameter Param1 (ValUint32 10), ParameterN N1 (ValUint8 2), Parameter
 Param2 (ValUint16 439), ParameterN N2 (ValUint8 2),
 Parameter Param3 (ValUint8 12), Parameter Param3 (ValUint8 13),
 Parameter Param2 (ValUint16 65535), ParameterN N2 (ValUint8 2),
 Parameter Param3 (ValUint8 22), Parameter Param3 (ValUint8 23)]

 Now I am a bit lost on how to implement such a parser. It would be much
 easier if the structure would be already encoded in the binary data, but I
 have to stick to this template approach. I have some C++ parser which does
 this but of course it's very imperative and a little bit quirky implemented,
 so if anybody has an idea on how to proceed (cereal, attoparsec whatever),
 please tell me.


 lg,
 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] Fractional Part

2011-08-02 Thread Eric Rasmussen
Just a hint, but with Project Euler there's a chance you're headed in a
difficult direction if you're working with the decimal parts directly.
Usually (always?) you can approach the problem in a way that won't depend on
something like decimal precision that can be different across
systems/languages/etc.

Best,
Eric



On Tue, Aug 2, 2011 at 4:36 PM, Mark Spezzano valh...@chariot.net.auwrote:

 Hi Ata,

 You could write the following

 decimalPart :: Float - Integer
 decimalPart f = read (tail (tail (show (f :: Integer

 This basically says convert f into a String using the show function, and
 then get the tail of that String twice to get rid of  the leading zero and
 the decimal point then read the result back as an Integer.

 To use this function you would type at the prompt:

 decimalPart 0.123

 which gives

 123

 This is probably not a very elegant solution, but it will work.


 Cheers,

 Mark


 On 03/08/2011, at 8:36 AM, Ata Jafari wrote:

  Hi everyone,
  I'm totally new to Haskell and functional programming. I try to solve
 some problems from Proejct Euler with Haskell so that I can improve myself
 in functional programming.
  In the first step I want to write a little code that can give me only the
 decimal part of a float. For instance:
  if the number is (0.123) I want to obtain only the (123) part to do some
 processes on that. (I mean the result of this code must be an integer.)
  I don't expect any complete code, any suggestion and help will be
 appreciated.
  Thanks
  Ata
 
  ___
  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] file splitter with enumerator package

2011-07-25 Thread Eric Rasmussen
I just found another solution that seems to work, although I don't
fully understand why. In my original function where I used EB.take to
strictly read in a Lazy ByteString and then L.hPut to write it out to
a handle, I now use this instead (full code in the annotation here:
http://hpaste.org/49366):

EB.isolate bytes =$ EB.iterHandle handle

It now runs at the same speed but in constant memory, which is exactly
what I was looking for. Is it recommended to nest iteratees within
iteratees like this? I'm surprised that it worked, but I can't see a
cleaner way to do it because of the other parts of the program that
complicate matters. At this point I've achieved my original goals,
unusual as they are, but since this has been an interesting learning
experience I don't want it to stop there if there are more idiomatic
ways to write code with the enumerator package.

On Mon, Jul 25, 2011 at 4:06 AM, David McBride dmcbr...@neondsl.com wrote:
 Well I was going to say:

 import Data.Text.IO as T
 import Data.Enumerator.List as EL
 import Data.Enumerator.Text as ET

 run_ $ (ET.enumHandle fp $= ET.lines) $$ EL.mapM_ T.putStrLn

 for example.  But it turns out this actually concatenates the lines
 together and prints one single string at the end.  The reason is
 because it turns out that ET.enumHandle already gets lines one by one
 without you asking and it doesn't add newlines to the end, so ET.lines
 looks at each chunk and never sees any newlines so it returns the
 entire thing concatenated together figuring that was an entire line.
 I'm kind of surprised that enumHandle fetches linewise rather than to
 let you handle it.

 But if you were to make your own enumHandle that wasn't linewise that
 would work.

 On Mon, Jul 25, 2011 at 6:26 AM, Yves Parès limestr...@gmail.com wrote:
 Okay, so there, the chunks (xs) will be lines of Text, and not just random
 blocks.
 Isn't there a primitive like printChunks in the enumerator library, or are
 we forced to handle Chunks and EOF by hand?

 2011/7/25 David McBride dmcbr...@neondsl.com

 blah = do
  fp - openFile file ReadMode
  run_ $ (ET.enumHandle fp $= ET.lines) $$ printChunks True

 printChunks is super duper simple:

 printChunks printEmpty = continue loop where
        loop (Chunks xs) = do
                let hide = null xs  not printEmpty
                CM.unless hide (liftIO (print xs))
                continue loop

        loop EOF = do
                liftIO (putStrLn EOF)
                yield () EOF

 Just replace print with whatever IO action you wanted to perform.

 On Mon, Jul 25, 2011 at 4:31 AM, Yves Parès limestr...@gmail.com wrote:
  Sorry, I'm only beginning to understand iteratees, but then how do you
  access each line of text output by the enumeratee lines within an
  iteratee?
 
  2011/7/24 Felipe Almeida Lessa felipe.le...@gmail.com
 
  On Sun, Jul 24, 2011 at 12:28 PM, Yves Parès limestr...@gmail.com
  wrote:
   If you used Data.Enumerator.Text, you would maybe benefit the lines
   function:
  
   lines :: Monad m = Enumeratee Text Text m b
 
  It gets arbitrary blocks of text and outputs lines of text.
 
   But there is something I don't get with that signature:
   why isn't it:
   lines :: Monad m = Enumeratee Text [Text] m b
   ??
 
  Lists of lines of text?
 
  Cheers, =)
 
  --
  Felipe.
 
 
  ___
  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] file splitter with enumerator package

2011-07-24 Thread Eric Rasmussen
Since the program only needs to finish a line after it's made a bulk
copy of a potentially large chunk of a file (could be 25 - 500 mb), I
was hoping to find a way to copy the large chunk in constant memory
and without inspecting the individual bytes/characters. I'm still
having some difficulty with this part if anyone has suggestions.

Thanks again,
Eric


On Sun, Jul 24, 2011 at 10:34 AM, Felipe Almeida Lessa
felipe.le...@gmail.com wrote:
 On Sun, Jul 24, 2011 at 12:28 PM, Yves Parès limestr...@gmail.com wrote:
 If you used Data.Enumerator.Text, you would maybe benefit the lines
 function:

 lines :: Monad m = Enumeratee Text Text m b

 It gets arbitrary blocks of text and outputs lines of text.

 But there is something I don't get with that signature:
 why isn't it:
 lines :: Monad m = Enumeratee Text [Text] m b
 ??

 Lists of lines of text?

 Cheers, =)

 --
 Felipe.


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


[Haskell-cafe] file splitter with enumerator package

2011-07-22 Thread Eric Rasmussen
Hi everyone,

A friend of mine recently asked if I knew of a utility to split a
large file (4gb in his case) into arbitrarily-sized files on Windows.
Although there are a number of file-splitting utilities, the catch was
it couldn't break in the middle of a line. When the standard why
don't you use Linux? response proved unhelpful, I took this as an
opportunity to write my first program using the enumerator package.

If anyone has time, I'm really interested in knowing if there's a
better way to take the incoming stream and output it directly to a
file. The basic steps I'm taking are:

1) Data.Enumerator.Binary.take -- grabs the user-specified number of
bytes, then (because it returns a lazy ByteString) I use
Data.ByteString.Lazy.hPut to output the chunk
2) Data.Enumerator.Binary.head -- after using take for the big chunk,
it inspects and outputs individual characters and stops after it
outputs the next newline character
3) I close the handle that steps 12 used to output the data and then
repeat 12 with the next handle (an infinite lazy list of filepaths
like part1.csv, part2.csv, and so on)

The full code is pasted here: http://hpaste.org/49366, and while I'd
like to get any other feedback on how to make it better, I want to
note that I'm not planning to release this as a utility so I wouldn't
want anyone to spend extra time performing a full code review.

Thanks!
Eric

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


Re: [Haskell-cafe] file splitter with enumerator package

2011-07-22 Thread Eric Rasmussen
Hi Felipe,

Thank you for the very detailed explanation and help. Regarding the first
point, for this particular use case it's fine if the user-specified file
size is extended by the length of a partial line (it's a compact csv file so
if the user breaks a big file into 100mb chunks, each chunk would only ever
be about 100mb + up to 80 bytes, which is fine for the user).

I'm intrigued by the idea of making the bulk copy function with EB.isolate
and EB.iterHandle, but I couldn't find a way to fit these into the larger
context of writing to multiple file handles. I'll keep working on it and see
if I can address the concerns you brought up.

Thanks again!
Eric




On Fri, Jul 22, 2011 at 6:00 PM, Felipe Almeida Lessa 
felipe.le...@gmail.com wrote:

 There is one problem with your algorithm.  If the user asks for 4 GiB,
 then the program will create files with *at least* 4 GiB.  So the user
 would need to ask for less, maybe 3.9 GiB.  Even so there's some
 danger, because there could be a 0.11 GiB line on the file.

 Now, the biggest problem your code won't run in constant memory.
 'EB.take' does not lazily return a lazy ByteString.  It strictly
 returns a lazy ByteString [1].  The lazy ByteString is used to avoid
 copying data (as it is basically the same as a linked list of strict
 bytestrings).  So if the user asked for 4 GiB files, this program
 would need at least 4 GiB of memory, probably more due to overheads.

 If you want to use lazy lazy ByteStrings (lazy ByteStrings with lazy
 I/O, as oposed to lazy ByteStrings with strict I/O), the enumerator
 package doesn't really buy you anything.  You should just use
 bytestring package's lazy I/O functions.

 If you want the guarantee of no leaks that enumerator gives, then you
 have to use another way of constructing your program.  One safe way of
 doing it is something like:

  takeNextLine :: E.Iteratee B.ByteString m (Maybe L.ByteString)
  takeNextLine = ...

  go :: Monad m = Handle - Int64 - E.Iteratee B.ByteString m (Maybe
 L.ByteString)
  go h n = do
mline - takeNextLine
case mline of
  Nothing - return Nothing
  Just line
| L.length line = n - L.hPut h line  go h (n - L.length line)
| otherwise - return mline

 So 'go h n' is the iteratee that saves at most 'n' bytes in handle 'h'
 and returns the leftover data.  The driver code needs to check its
 results.  Case 'Nothing', then the program finishes.  Case 'Just
 line', save line on a new file and call 'go h2 (n - L.length line)'.
 It isn't efficient because lines could be small, resulting in many
 small hPuts (bad).  But it is correct and will never use more than 'n'
 bytes (great).  You could also have some compromise where the user
 says that he'll never have lines longer than 'x' bytes (say, 1 MiB).
 Then you call a bulk copy function for 'n - x' bytes, and then call
 'go h x'.  I think you can make the bulk copy function with EB.isolate
 and EB.iterHandle.

 Cheers, =)

 [1]
 http://hackage.haskell.org/packages/archive/enumerator/0.4.13.1/doc/html/src/Data-Enumerator-Binary.html#take

 --
 Felipe.

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


Re: [Haskell-cafe] Searching of several substrings (with Data.Text ?)

2011-07-05 Thread Eric Rasmussen
I've been looking into building parsers at runtime (from a config
file), and in my case it's beneficial to fit them into the context of
a larger parser with Attoparsec.Text. This code is untested for
practical use so I doubt you'll see comparable performance to the
aforementioned regex packages, but it could be worth exploring if you
need to mix and match parsers or if the definitions can change
arbitrarily at runtime.

import qualified Data.Text as T
import Data.Attoparsec.Text
import Control.Applicative ((|))

parseLigature x = string (T.pack x)

charToText = do c - anyChar
return (T.singleton c)

buildChain [x]= parseLigature x
buildChain (x:xs) = try (parseLigature x) | buildChain xs

-- ordering matters here, so ffi comes before ff or fi
ligatures = buildChain [ffi, th, ff, fi, fl]

myParser = many (try ligatures | charToText)

-- at ghci prompt: parseOnly myParser (T.pack the fluffiest bunny)
-- Right [th,e, ,fl,u,ffi,e,s,t, ,b,u,n,n,y]




On Tue, Jul 5, 2011 at 12:09 PM, Bryan O'Sullivan b...@serpentine.com wrote:
 On Tue, Jul 5, 2011 at 11:01 AM, Tillmann Vogt
 tillmann.v...@rwth-aachen.de wrote:

 I looked at Data.Text
 http://hackage.haskell.org/packages/archive/text/0.5/doc/html/Data-Text.html
 and
 http://hackage.haskell.org/packages/archive/stringsearch/0.3.3/doc/html/Data-ByteString-Search.html

 but they don't have a function that can search several substrings in one
 run.

 Here's what you want:
 http://hackage.haskell.org/packages/archive/text-icu/0.6.3.4/doc/html/Data-Text-ICU-Regex.html
 ___
 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] attoparsec and vectors

2011-06-28 Thread Eric Rasmussen
Hi everyone,

I have a task that involves parsing a flat-file into a vector from the
Data.Vector package. In the interest of keeping things simple, I first used
Attoparsec.Text's version of many and then converted the resulting list to
a vector:

import qualified Data.Vector as V
import Data.Attoparsec.Text as A
import Control.Applicative

getData = do results - A.many someParser
return (V.fromList results)

It runs quickly, but I naively thought I could outperform it by reworking
many to build a vector directly, instead of having to build a list first
and then convert it to a vector:

manyVec :: Alternative f = f a - f (V.Vector a)
manyVec v = many_v
  where many_v = some_v | pure V.empty
some_v = V.cons $ v * many_v

Unfortunately, manyVec either quickly leads to a stack space overflow, or it
takes an enormous amount of time to run. Does anyone know of a better way to
build up a vector from parsing results?

Thanks for any tips or insight,
Eric
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Iteratee IO examples

2011-06-24 Thread Eric Rasmussen
Hi,

Examples are very helpful to me too -- thank you for sharing. I'm especially
curious to see if there are any examples that allow you to use or convert
non-iteratee-based functions. I have only just begun reading about iteratees
and might be missing the point, but it seems like many of the examples so
far rely on explicit recursion or special functions from one of the iteratee
modules.

Is there a way to take a simple function (example below) and use an
enumerator to feed it a ByteString from a file, or do you have to write
functions explicitly to work with a given iteratee implementation?

import qualified Data.ByteString.Char8 as B
sortLines = B.unlines . sort . B.lines

Thanks!
Eric



On Fri, Jun 24, 2011 at 7:24 AM, Henk-Jan van Tuyl hjgt...@chello.nlwrote:

 On Fri, 24 Jun 2011 15:11:59 +0200, David Place d...@vidplace.com wrote:

  Hi,

 I've been trying to learn Iteratee IO.  I've made some progress by
 studying John Millikin's examples in the source of the enumerator package.

 I was surprised how confusing I found the tutorials that are available.  I
 think that it is primarily because of the lack of concrete examples.  It
 would be great if we could accumulate a collection of small concrete
 programs like John's wc.hs which show various uses of Data.Enumerator.

 Here's a little program I wrote to find the longest run of same characters
 in a file.

  http://hpaste.org/48255


 Does anyone else have little examples like this that use Iteratee IO?


 Try finding packages that depend on the enumerator/iteratee packages at
  http://bifunctor.homelinux.**net/~roel/hackage/packages/**
 archive/pkg-list.htmlhttp://bifunctor.homelinux.net/%7Eroel/hackage/packages/archive/pkg-list.html
 (which is down at the moment).

 Regards,
 Henk-Jan van Tuyl


 --
 http://Van.Tuyl.eu/
 http://members.chello.nl/**hjgtuyl/tourdemonad.htmlhttp://members.chello.nl/hjgtuyl/tourdemonad.html
 --


 __**_
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://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] Generating simple histograms in png format?

2011-06-12 Thread Eric Rasmussen
There is a program written in Haskell called Timeplot that does this:
http://www.haskell.org/haskellwiki/Timeplot

It's an executable rather than a library, but you can use your own Haskell
code to preprocess/format data and pipe it to the program to generate
histograms as pngs.

Best,
Eric


On Sun, Jun 12, 2011 at 6:40 AM, C K Kashyap ckkash...@gmail.com wrote:

 You might find this useful -
 http://www.haskell.org/haskellwiki/Library/PNG
 Btw, I too am looking for such a library.
 Regards,
 Kashyap

 On Sat, Jun 11, 2011 at 3:32 AM, Dmitri O.Kondratiev doko...@gmail.comwrote:

 I am looking for platform-independent library to generate simple
 histograms in png format.
 Does such thing exist?

 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


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


Re: [Haskell-cafe] haskellwiki slow/unresponsive

2011-06-03 Thread Eric Rasmussen
This is a bit of a tangent, but has anyone developed wiki software in
Haskell?

If anyone is working on this or interested in working on it, I'd like to
help. I've built simple wiki applications with Python web frameworks and
have been looking for a good project to start learning one of the Haskell
web application frameworks. Eventually it'd be nice to proudly advertise all
the prominent Haskell community pages as being powered by Haskell.

Thanks!
Eric


On Fri, Jun 3, 2011 at 12:50 PM, Greg Weber g...@gregweber.info wrote:

 I have been trying to make a few edits to the haskell wiki and find it an
 excruciating process when I press save and then have to wait a long time to
 see if the save will go through. I just clicked on the introduction page and
 it may have took an entire minute to load.

 Can we put at the top: this wiki written in php, not haskell!

 Seriously though, the wiki has performed poorly for a long time now. It
 gives a bad impression to newcomers and deters contributions. Can I (and
 others!) donate money so someone can make the wiki responsive?

 Thanks,
 Greg Weber

 ___
 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] haskellwiki slow/unresponsive

2011-06-03 Thread Eric Rasmussen
Those are definitely valid concerns. Has anyone made a wiki-like site with
Yesod? I hadn't heard of Yesod until I joined this mailing list, but I've
seen quite a bit of buzz around it since then. If a large enough chunk of
the community is backing a framework and focusing on making it secure and
reliable, then it should be possible to build applications with it (wikis,
blogs, etc.) that draw on the framework's strength and security. You may
still have security issues, but if they're continually addressed and
maintained at the framework level it benefits everyone building applications
on top of that framework. I'm still relatively new to the Haskell community
so I apologize if much of this has been addressed before!


On Fri, Jun 3, 2011 at 3:11 PM, Gwern Branwen gwe...@gmail.com wrote:

 On Fri, Jun 3, 2011 at 4:17 PM, Eric Rasmussen ericrasmus...@gmail.com
 wrote:
  This is a bit of a tangent, but has anyone developed wiki software in
  Haskell?

 Gitit is the most developed one, and it's been suggested in the past
 that hawiki move over. It's not a good idea for a couple reasons,
 which I've said before but I'll repeat here:

 1. Performance; there have been major issues with the Darcs backend,
 though mostly resolved, and we don't know how well the Git backend
 would scale either. Gitit has mostly been used with single-users (how
 I use it) or projects with light traffic (wiki.darcs.net). I don't
 know why hawiki is slow, but whatever it is is probably either
 hardware or configuration related - MediaWiki after all powers one of
 the most popular websites in the world.
 2. Security; there have been big holes in Gitit. Some of it is simple
 immaturity, some of it due to the DVCS backends. Where there is one
 hole, there are probably more - if there aren't holes in the Gitit
 code proper, there probably are some in Happstack. There's no reason
 to think there aren't: security is extremely hard. And in that
 respect, Mediawiki is simply much more battle-tested. (Most popular
 websites in the world, again, and one that particularly invites abuse
 and attack.)
 3. The existing hawiki content is Mediawiki centric, relying on
 templates and MW syntax etc. Templates alone would have to be
 implemented somehow, and Pandoc's MW parser is, last I heard, pretty
 limited.

 Gitit is great for what it is, and I like using it - but it's not
 something I would rely on for anything vital, and especially not for
 something which might be attacked. (This isn't paranoia; I deal with
 spammers every day on hawiki, and c.h.o was rooted recently enough
 that the memory should still be fresh in our collective minds.)

 --
 gwern
 http://www.gwern.net

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


[Haskell-cafe] representing spreadsheets

2011-05-27 Thread Eric Rasmussen
Hi everyone,

I'm hoping someone can point me in the right direction for a project I'm
working on. Essentially I would like to represent a grid of data (much like
a spreadsheet) in pure code. In this sense, one would need functions to
operate on the concepts of rows and columns. A simple cell might be
represented like this:

data Cell =
CellStr   Text
  | CellInt   Integer
  | CellDbl   Double
  | CellEmpty

The spreadsheet analogy isn't too literal as I'll be using this for data
with a more regular structure. For instance, one grid might have 3 columns
where every item in column one is a CellStr, every item in column two a
CellStr, and every item in column 3 a CellDbl, but within a given grid there
won't be surprise rows with extra columns or columns that contain some cell
strings, some cell ints, etc.

Representing cells in a matrix makes the most sense to me, in order to
facilitate access by columns or rows or both, and I'd like to know if
there's a particular matrix library that would work well with this idea.
However, I'm certainly open to any other data structures that may be better
suited to the task.

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


Re: [Haskell-cafe] representing spreadsheets

2011-05-27 Thread Eric Rasmussen
Stephen, thanks for the link! The paper was an interesting read and
definitely gave me some ideas.

Tillmann -- you are correct in that it's very similar to a database.

I frequently go through this process:

1) Receive a flat file (various formats) of tabular data
2) Create a model of the data and a parser for the file
3) Code utilities that allow business users to
filter/query/accumulate/compare the files

The models are always changing, so one option would be to inspect a
user-supplied definition, build a SQLite database to match, and use Haskell
to feed in the data and run queries. However, I'm usually dealing with files
that can easily be loaded into memory, and generally they aren't accessed
with enough frequency to justify persisting them in a separate format.

It's actually worked fine in the past to code a custom data type with record
syntax (or sometimes just tuples) and simply build a list of them, but the
challenge in taking this to a higher level is reading in a user-supplied
definition, perhaps translated as 'the first column should be indexed by the
string Purchase amount and contains a Double', and then performing
calculations on those doubles based on further user input. I'm trying to get
over bad object-oriented habits of assigning attributes at runtime and
inspecting types to determine which functions can be applied to which data,
and I'm not sure what concepts of functional programming better address
these requirements.


On Fri, May 27, 2011 at 12:33 PM, Tillmann Rendel 
ren...@informatik.uni-marburg.de wrote:

 Hi,


 Eric Rasmussen wrote:

 The spreadsheet analogy isn't too literal as I'll be using this for data
 with a more regular structure. For instance, one grid might have 3 columns
 where every item in column one is a CellStr, every item in column two a
 CellStr, and every item in column 3 a CellDbl, but within a given grid
 there
 won't be surprise rows with extra columns or columns that contain some
 cell
 strings, some cell ints, etc.


 Sounds more like a database than like a spreadsheet.

  Tillmann


 ___
 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] representing spreadsheets

2011-05-27 Thread Eric Rasmussen
Thanks! I think GADTs may work nicely for this project, so I'm going to
start building it out.

On Fri, May 27, 2011 at 4:16 PM, Alexander Solla alex.so...@gmail.comwrote:

 On Fri, May 27, 2011 at 3:11 PM, Eric Rasmussen 
 ericrasmus...@gmail.comwrote:

 Stephen, thanks for the link! The paper was an interesting read and
 definitely gave me some ideas.

 Tillmann -- you are correct in that it's very similar to a database.

 I frequently go through this process:

 1) Receive a flat file (various formats) of tabular data
 2) Create a model of the data and a parser for the file
 3) Code utilities that allow business users to
 filter/query/accumulate/compare the files

 The models are always changing, so one option would be to inspect a
 user-supplied definition, build a SQLite database to match, and use Haskell
 to feed in the data and run queries. However, I'm usually dealing with files
 that can easily be loaded into memory, and generally they aren't accessed
 with enough frequency to justify persisting them in a separate format.


 Worth it in what terms?  You're either going to have to encode the
 relationships yourself, or else automate the process.


 It's actually worked fine in the past to code a custom data type with
 record syntax (or sometimes just tuples) and simply build a list of them,
 but the challenge in taking this to a higher level is reading in a
 user-supplied definition, perhaps translated as 'the first column should be
 indexed by the string Purchase amount and contains a Double', and then
 performing calculations on those doubles based on further user input. I'm
 trying to get over bad object-oriented habits of assigning attributes at
 runtime and inspecting types to determine which functions can be applied to
 which data, and I'm not sure what concepts of functional programming better
 address these requirements.


 My intuition is to use some kind of initial algebra to create a list-like
 structure /for each record/  For example, with GADTs:.

 data Field a = Field { name  :: String }
 data Value a = Value { value :: a }


  Presumably, your data definition will parse
  into:
 data RecordScheme where
  NoFields :: RecordScheme
  AddField :: Field a - RecordScheme - RecordScheme

  And then, given a record scheme, you can
  construct a Table running the appropriate
  queries for the scheme and Populating its
  Records.

 data Record where
  EndOfRecord :: Record
  Populate:: Value a - Record - Record

 type Table = [Record]


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


Re: [Haskell-cafe] The Lisp Curse

2011-05-23 Thread Eric Rasmussen
In terms of making the interface more friendly to beginners, I wonder if
this is partially an issue of how to search and how to format the results. I
just searched several places for xml rpc and found:

Hackage: the first few links from the google search are different versions
of haxr
Hayoo: 0 packages found, but lists functions from packages including haxr
Hoogle: No results found
Haskell.org: No matches

When that happens I can broaden my search (just RPC or just XML), or I can
go to google and search haskell xml rpc and find results, but without any
sense of what I should be clicking on. I'll often start in one place, then
hear about something on Haskell-Cafe that's more widely used and never came
up in the results.

I realize Hayoo and Hoogle are specialized searches (although I imagine
people do occasionally use them the way I did in this example), but it would
be great if Hackage's search feature could provide its own summary results
in a simple table, perhaps like this:

Date Released | Last Updated | Downloads | Focus

Where focus is a one or two liner explaining the intended use or scope of
the package, ideally written with comparisons to similar packages in mind.
That way if you search xml rpc and are immediately given results for a
couple of packages, you can get some sense of what's current, what's being
used, and the scope or intended use of the package.

I'm not sure if this format would work for everyone of course, but I do
think some of the ideas coming out of this discussion are promising. And for
my part, I'm going to make an effort to participate on the wiki once I wrap
a couple projects.

Best,
Eric




On Mon, May 23, 2011 at 8:31 AM, KC kc1...@gmail.com wrote:

 Librarians have been struggling for years with classifying topics; I
 don't imagine classifying coding libraries as any easier. :)




 --
 --
 Regards,
 KC

 ___
 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] The Lisp Curse

2011-05-19 Thread Eric Rasmussen
I only recently started learning Haskell and have had a difficult time
convincing other Python hackers to come on board. I see two things that
might help:

1) A resource to make informed decisions about different libraries.
Something that includes specific criteria like how long a library has been
out, how often it's maintained, how many people use it, etc. Ideally you'd
be able to see a quick table comparison of features across libraries that
perform similar tasks (roughly translated to something like: this xml
library is well established, has great documentation, and works for most
parsing tasks, while this other one is much faster but not widely used
yet).

2) Languages like Python make it easy to write fast performing code in a few
lines that will read/write files, split strings, and build lists or
dictionaries/associative arrays. There are very clever ways of doing all
these things Haskell, but it can involve several qualified imports and time
researching ByteStrings/Lazy ByteStrings/ByteString.Char8. It would be nice
to have a single module that exports some common text operations via
ByteStrings without requiring a lot of upfront research time learning to
work with ByteStrings, and possibly a limited export of Data.Map features as
well.

The second one would hold little interest for advanced developers of course,
but when someone is faced with a difficult learning task, if you give them a
strong starting point that produces results it can help motivate them to
keep learning. Is anyone working on either of these things or interested in
working on them? I'm not quite ready to produce high quality Haskell code
yet, but I'd like to contribute if I can.


On Thu, May 19, 2011 at 3:42 PM, David Leimbach leim...@gmail.com wrote:

 See the Haskell Platform.

 Sent from my iPhone

 On May 19, 2011, at 1:56 PM, Andrew Coppin andrewcop...@btinternet.com
 wrote:

  On 19/05/2011 09:34 PM, vagif.ve...@gmail.com wrote:
  Andrew, you are being non constructive.
 
  It seems I'm being misunderstood.
 
  Some people seem to hold the opinion that more libraries = better. I'm
 trying to voice the opinion that there is such a thing as too many
 libraries. The article I linked to explains part of why this is the case, in
 a better way than I've been able to phrase it myself.
 
  I'm not trying to say OMG, the way it is now completely sucks! I'm not
 trying to say you must do X right now! I'm just trying to put forward an
 opinion. The opinion that having too many libraries can be a problem, which
 some people don't seem to agree with. (Obviously it isn't *always* bad, I'm
 just saying that sometimes it can be.)
 
  That's all I was trying to say.
 
  ___
  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] parsing currency amounts with parsec

2011-05-12 Thread Eric Rasmussen
Very helpful -- thanks everyone! The handling of currency amounts in hledger
is what I was looking for in terms of alternate ways to parse and represent
dollar amounts in Haskell.

On Wed, May 11, 2011 at 6:05 PM, Simon Michael si...@joyful.com wrote:

 On 5/10/11 2:52 PM, Roman Cheplyaka wrote:

 You could read hledger[1] sources for inspiration: it's written in
 Haskell and contains some (quite generic) currency parsing.


 Hi Eric.. here's the code in question:


 http://hackage.haskell.org/packages/archive/hledger-lib/0.14/doc/html/src/Hledger-Read-JournalReader.html#postingamount

 and some related docs:

 http://hledger.org/MANUAL.html#amounts

 It's probably more complicated and less efficient than you need, but a
 source of ideas.



 ___
 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] parsing currency amounts with parsec

2011-05-09 Thread Eric Rasmussen
Hi everyone,

I am relatively new to Haskell and Parsec, and I couldn't find any articles
on parsing numbers in the following format:

Positive: $115.33
Negative: ($1,323.42)

I'm working on the parser for practical purposes (to convert a 3rd-party
generated, most unhelpful format into one I can use), and I'd really
appreciate any insight into a better way to do this, or if there are any
built-in functions/established libraries that would be better suited to the
task. My code below works, but doesn't seem terribly efficient.

Thanks!
Eric

-
{- parses positive and negative dollar amounts -}

integer :: CharParser st Integer
integer = PT.integer lexer

float :: CharParser st Double
float = PT.float lexer

currencyAmount = try negAmount | posAmount

negAmount = do char '('
  char '$'
  a - currency
  char ')'
  return (negate a)

posAmount = do char '$'
  a - currency
  return a

currency = do parts - many floatOrSep
 let result = combine orderedParts where
   combine = sumWithFactor 1
   orderedParts = reverse parts
 return result

floatOrSep = try float | beforeSep

beforeSep = do a - integer
  char ','
  return (fromIntegral a :: Double)

sumWithFactor n [] = 0
sumWithFactor n (x:xs) = n * x + next
where next = sumWithFactor (n*1000) xs
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] parsing currency amounts with parsec

2011-05-09 Thread Eric Rasmussen
I'll check out Attoparsec, thanks! My first attempt may work for this
particular task, but I'm warming up for a more intense parsing project and
it sounds like Attoparsec with Bytestrings may work best.

Also, just in case anyone reads this thread later and is looking for a quick
Parsec solution, I discovered that the code I posted initially was a bit
greedy in a bad way if the dollar amount was at the end of the line. I got
rid of the original currency, floatOrSep, and beforeSep functions and
replaced them with the code below (still verbose, but hopefully a better
starting point for now).



double = do i - integer
return (fromIntegral i :: Double)

currency = try float | largeAmount

largeAmount = do first - double
 rest  - many afterSep
 let parts = first : rest
 let result = combine orderedParts where
 combine = sumWithFactor 1
 orderedParts = reverse parts
 return result

afterSep = do char ','
  try float | double




On Mon, May 9, 2011 at 8:15 PM, wren ng thornton w...@freegeek.org wrote:

 On 5/9/11 10:04 PM, Antoine Latter wrote:

 On Mon, May 9, 2011 at 5:07 PM, Eric Rasmussenericrasmus...@gmail.com
  wrote:

 Hi everyone,

 I am relatively new to Haskell and Parsec, and I couldn't find any
 articles
 on parsing numbers in the following format:

 Positive: $115.33
 Negative: ($1,323.42)

 I'm working on the parser for practical purposes (to convert a 3rd-party
 generated, most unhelpful format into one I can use), and I'd really
 appreciate any insight into a better way to do this, or if there are any
 built-in functions/established libraries that would be better suited to
 the
 task. My code below works, but doesn't seem terribly efficient.


 Why do you think it inefficient? Is it slow?

 I don't have any substantial suggestions, but from a style perspective:

 * I would question the use of IEEE binary-floating-point number types
 for currency. Haskell ships with a fixed-point decimal library, but I
 don't know how fast it is:

 http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Fixed.html


 There are also a few other options (that I can't seem to find links to at
 the moment), and some hints on how to do it yourself:



 http://augustss.blogspot.com/2007/04/overloading-haskell-numbers-part-3.html


 I'm not sure if your choice of parsing library is fixed or not, but you
 could probably speed things up significantly by using Attoparsec. In
 particular, Attoparsec's combinators for takeWhile, takeWhile1,scan,...
 return bytestrings, and you can then fold over the bytestring quite nicely.
 If your source is ASCII or anything ASCII compatible (Latin-1, Latin-9,
 UTF-8,...) then take a look at Data.Attoparsec.Char8.decimal[1][2].

 Unless you need to verify that commas occur exactly every third digit, I'd
 suggest (a) dropping commas while scanning the string, or (b) implicitly
 dropping commas while folding over the string. If you do need to verify
 this, then your best option is (a), since you can maintain a state machine
 about how many digits seen since the last comma. Once you're using the
 Attoparsec strategy of folding over the raw byte buffers, then the only room
 for improvement is going to be making the code as straight-line as possible.

 Some untested example code:

import qualified Data.Attoparsec   as A
import qualified Data.Attoparsec.Char8 as A8
import qualified Data.ByteString   as B

rawCurrency :: A.Parser (ByteString,ByteString)
rawCurrency = do
dollars - A.scan 0 step
_   - A.char '.'   -- Assuming it's required...
cents   - A.takeWhile1 isDigit_w8  -- Assuming no commas...
return (dollars,cents)
where
step :: Int - Word8 - Maybe Int
step 3 0x2C = Just 0
step s c | isDigit_w8 c = Just $! s+1
step _ _= Nothing

-- Note: the order of comparisons is part of why it's fast.
-- | A fast digit predicate.
isDigit_w8 :: Word8 - Bool
isDigit_w8 w = (w = 0x39  w = 0x30)
{-# INLINE isDigit_w8 #-}

-- With the dots filled in by whatever representation you use.
currency :: A.Parser ...
currency = do
(dollars,cents) - rawCurrency
let step a w = a * 10 + fromIntegral (w - 0x30)
d = B.foldl' step 0 (B.filter (/= 0x2C) dollars)
c = fromIntegral (B.foldl' step 0 cents)
/ (10 ^ length cents)
return (... d ... c ...)

amount :: A.Parser ...
amount = pos | neg
where
pos = A8.char '$' * currency
neg = do
_ - A8.string ($
a - currency
_ - A8.char ')'
return (negate a)




 [1] And if you're using 

Re: [Haskell-cafe] Server hosting

2011-05-06 Thread Eric Rasmussen
Has anyone tried webfaction.com with Haskell?

I use them for custom Python web apps and they're great (competitive shared
hosting price, ssh access, easy to setup proxy apps listening on custom
ports or cgi apps with the ability to edit .htaccess). Loosely speaking it's
a cross between traditional shared hosting and VPS hosting, but I'm not
quite ready for web development with Haskell yet so I've only used it with
Python.

On Fri, May 6, 2011 at 12:21 PM, Christopher Done
chrisd...@googlemail.comwrote:

 On 6 May 2011 20:18, Steffen Schuldenzucker 
 sschuldenzuc...@uni-bonn.dewrote:

 I don't really expect this to work, but...


 ?php

 $argsstr = ...
 $ok = 0
 passthru( './my_real_cgi '.$argsstr, $ok );
 exit( $ok );

 ?


 I actually got something like that to work on a shared host before, I used
 PHP as the starter and then served a CGI app. You need to make sure the
 shared libraries for Haskell are on there too (gmp, for example, IIRC).

 ___
 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] ANN: timeplot-0.3.0 - the analyst's swiss army knife for visualizing ad-hoc log files

2011-05-06 Thread Eric Rasmussen
Hi Eugene,

This is a great tool. I often have to analyze data from multiple sources, so
I usually create a SQLite database to store it all and start running
queries. I just tested it in the form:

$ echo 'SELECT...' | sqlite3 database.db | tplot options

And for more complicated queries outputting the results to file then reading
it in with tplot. Both worked great.

Thanks,
Eric



On Sun, May 1, 2011 at 12:14 PM, Eugene Kirpichov ekirpic...@gmail.comwrote:

 Hello,

 Sorry for the broken link: the correct link to the presentation is:

 http://jkff.info/presentations/two-visualization-tools.pdf

 2011/4/30 Eugene Kirpichov ekirpic...@gmail.com:
   Hello fellow haskellers,
 
  I announce the release of timeplot-0.3.0, the analyst's swiss army
  knife for visualizing ad-hoc log files.
 
  Links:
   * http://jkff.info/presentation/two-visualization-tools - a
  presentation saying what the tools are all about and giving plenty of
  graphical examples on cluster computing use cases. At the end of the
  presentation there's also a couple of slides about installation. It is
  a little bit outdated, it corresponds to versions just before 0.3.0.
   * http://hackage.haskell.org/package/timeplot
   * http://github.com/jkff/timeplot
   * The sibling tool, splot - for visualizing the activity of many
  concurrent processes - http://hackage.haskell.org/package/splot and
  http://github.com/jkff/splot . It has also gotten a couple of new
  features since my last announcement.
 
  The major new feature of tplot is the introduction of subplots, the
  'within' plots.
  It allows one to plot data from several sub-tracks on one track of the
 graph:
   - several line- or dot-plots
   - several plots of sums or cumulative sums, perhaps stacked (to see
  how the sub-tracks contribute to the total sum - e.g. if your log
  speaks about different types of overhead and you wish to see how they
  contribute to the total)
   - stacked activity count plot - a generalization of the previous
  activity count plot, which allows you to, given a log saying like
  Machine started servicing job JOB1 ... Machine finished servicing job
  JOB1 etc, plot how many machines are servicing each job at any
  moment, in a stacked fashion - so, how loads by different jobs
  contribute to the whole cluster's load. The activity frequency plot
  plots the same on a relative scale.
 
  The syntax is, for example: within[.] dots or within[.] acount or
  even within[.] duration cumsum stacked etc.
 
  Note that these are of course just example use cases and the tool is
  universal, it is not in any sense specialized to clusters, jobs,
  overheads or actually even to logs.
  I'd like to encourage you to give it a try and look around for a use case
 :)
 
  If you do give the tool a try, please tell me if something goes wrong,
  be it an installation problem or a bug (the version is fresh released,
  so this is quite possible).
 
  --
  Eugene Kirpichov
  Principal Engineer, Mirantis Inc. http://www.mirantis.com/
  Editor, http://fprog.ru/
 



 --
 Eugene Kirpichov
 Principal Engineer, Mirantis Inc. http://www.mirantis.com/
 Editor, http://fprog.ru/

 ___
 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] Comparison of common Haskell libraries (Was: Good reads?)

2011-04-27 Thread Eric Rasmussen
Thank you -- I will try your spreadsheet package for sure, and when I have
more expertise in this area I'd be happy to contribute to the wiki.


On Wed, Apr 27, 2011 at 3:00 AM, Henning Thielemann 
schlepp...@henning-thielemann.de wrote:

 Eric Rasmussen schrieb:

  Also, in the spirit of this discussion, is there a resource that
  attempts to compare libraries for common tasks so developers can make
  informed decisions without having to research each library or approach
  on their own? As an example, in other languages you might read about CSV
  parsing from a few different sources and see a general consensus on how
  to approach it. After hours of digging through code on Hackage and
  reading up on different approaches, I can't seem to find a consensus in
  Haskell.

 I think there won't be consensus in many cases, otherwise developers
 wouldn't have started to develop alternatives to existing packages.
 However if you did the work of comparing some libraries for the same
 purpose - how about writing a personal comparison in the HaskellWiki?

 For the special case of CSV parsing I would of course recommend my
 spreadsheet package because it parses lazily. :-)


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


Re: [Haskell-cafe] Good reads?

2011-04-26 Thread Eric Rasmussen
I'm currently reading Real World Haskell (
http://book.realworldhaskell.org/read/), and it's an excellent book. It goes
into detail on quite a few interesting and practical uses of the language.

Also, in the spirit of this discussion, is there a resource that attempts to
compare libraries for common tasks so developers can make informed decisions
without having to research each library or approach on their own? As an
example, in other languages you might read about CSV parsing from a few
different sources and see a general consensus on how to approach it. After
hours of digging through code on Hackage and reading up on different
approaches, I can't seem to find a consensus in Haskell.

If anyone knows of a book/resource that breaks down different approaches to
common problems and when/why you might choose one over the other, I'm very
interested.

-Eric Rasmussen


On Tue, Apr 26, 2011 at 3:52 PM, Edward Amsden eca7...@cs.rit.edu wrote:

 On Tue, Apr 26, 2011 at 5:48 PM, Christopher Svanefalk
 christopher.svanef...@gmail.com wrote:
  I am currently reading through Peyton-Jones Haskell: The Craft of
  Functional Programming (2nd ed.), as well as a great paper published by
  one of my professors
  (http://www.cse.chalmers.se/~rjmh/Papers/whyfp.html). However, what
  other works, in your opinions, should I look into to get a more complete
  understanding of functional programming?

 You might consult the Typeclassopedia (Brent Yorgey).

 Understanding these typeclasses helped me start understand the power
 of abstraction that Haskell (and FP in general) gives a programmer.

 quoth the abstract:
 The standard Haskell libraries feature a number of type classes with
 algebraic or category-theoretic underpinnings. Becoming a fluent
 Haskell hacker requires intimate familiarity with them all, yet
 acquiring this familiarity often involves combing through a mountain
 of tutorials, blog posts, mailing list archives, and IRC logs.

 The goal of this article is to serve as a starting point for the
 student of Haskell wishing to gain a firm grasp of its standard type
 classes. The essentials of each type class are introduced, with
 examples, commentary, and extensive references for further reading.

 http://www.haskell.org/wikiupload/8/85/TMR-Issue13.pdf, page 13

 And from a fellow student: have fun!

 --
 Edward Amsden
 Student
 Computer Science
 Rochester Institute of Technology
 www.edwardamsden.com

 ___
 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