Re: [Haskell-cafe] [Haskell] ANNOUNCE: tardis

2012-08-07 Thread Ben Millwood
On Tue, Aug 7, 2012 at 7:04 AM, Dan Burton danburton.em...@gmail.com wrote:
 As a side note, since the code base is relatively small, it can also serve
 as a simple demonstration of how to use a cabal flag
 in conjunction with CPP to selectively include swaths of code
 (see Control/Monad/Tardis.hs and tardis.cabal).

Eep, your API changes based on compile-time settings. I think this is
a bad idea, because other packages cannot depend on a flag, so
realistically other packages cannot depend on the instances existing,
so they're nearly useless.

UndecidableInstances is excessively maligned and usually fine anyway.
If it compiles, it won't go wrong.

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


Re: [Haskell-cafe] [Haskell] ANNOUNCE: notcpp-0.0.1

2012-04-15 Thread Ben Millwood
On Sun, Apr 15, 2012 at 7:14 PM, Steffen Schuldenzucker
sschuldenzuc...@uni-bonn.de wrote:


 On 04/13/2012 10:49 PM, Ben Millwood wrote:

 I'm pleased to announce my first genuinely original Hackage package:
 notcpp-0.0.1!

 http://hackage.haskell.org/package/notcpp

 [...]


 Why is it

 scopeLookup :: String - Q Exp
 with n bound to x :: T = @scopeLookup n@ evaluates to an Exp containing
 @Just x@

 , not

 scopeLookup :: String - Q (Maybe Exp)
 with n bound to x :: T = @scopeLookup n@ evaluates to Just (an Exp
 containing @x@)

 ? Shouldn't n's being in scope be a compile time decision? That would also
 make the openState: runtime name resolution has its drawbacks :/[1] a
 compile time error.

 -- Steffen

 [1]
 http://hackage.haskell.org/packages/archive/notcpp/0.0.1/doc/html/NotCPP-ScopeLookup.html

This way minimises the amount the user has to know about Template
Haskell, because the user can just splice the expression immediately
and then operate on it as an ordinary value. The design you suggest
would require messing about in the Q monad to construct the expression
you wanted based on whether you got a Nothing or a Just, which in my
view is more awkward. I can see how your version would be useful too,
though – in particular I can move the error call to a report call,
which throws a compile-time error as you say. I'd be happy to expose
both next version

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


Re: [Haskell-cafe] [Haskell] ANNOUNCE: haskell-src-meta 0.3

2011-01-04 Thread Ben Millwood
It seems I wasn't subscribed to haskell-cafe so this reply didn't get
through (sorry for sending this twice, Felipe).
I've now subscribed with delivery turned off for -cafe so if you want
me to read a response be sure to address me directly :)

On Tue, Jan 4, 2011 at 5:08 AM, Ben Millwood hask...@benmachine.co.uk wrote:
 On Tue, Jan 4, 2011 at 4:02 AM, Felipe Almeida Lessa
 felipe.le...@gmail.com wrote:
 On Tue, Jan 4, 2011 at 1:49 AM, Ben Millwood hask...@benmachine.co.uk 
 wrote:
 haskell-src-meta is a package originally written by Matt Morrow to
 provide a translation from the syntax tree provided by
 haskell-src-exts to template haskell syntax. Essentially this allows
 TH code to be parsed from a string, and is used in several quasiquoter
 libraries.

 Are the purposes of haskell-src-meta and haskell-src-exts-qq the same?
  What are the main differences?

 Cheers! =)

 --
 Felipe.


 If you look at the source for Language.Haskell.Exts.Translate from
 haskell-src-exts-qq [1], you can see that it was actually taken from
 an earlier version of haskell-src-meta, presumably during the long
 period for which HSM was not maintained. I guess you could say that it
 inlined the key parts of haskell-src-meta into its codebase, but I
 hope that the maintainer can feel more confident about using the
 haskell-src-meta package as a dependency now.

 My understanding of the *purpose* of haskell-src-exts-qq is that it is
 for easily generating ASTs for use with haskell-src-exts, whereas
 haskell-src-meta is for generating ASTs for use with template haskell.

 [1] 
 http://hackage.haskell.org/packages/archive/haskell-src-exts-qq/0.3.0/doc/html/src/Language-Haskell-Exts-Translate.html


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


Re: [Haskell-cafe] Re: Monads and Functions sequence and sequence_

2010-10-30 Thread Ben Millwood
The actual, entire, complete definitions of sequence and sequence_ are
(or at least, could be):

 sequence [] = return []
 sequence (m:ms) = do
   x - m
   xs - sequence ms
   return (x:xs)

 -- or, equivalently:
 sequence' = foldr (liftM2 (:)) (return [])

 sequence_ [] = return ()
 sequence_ (x:xs) = do
   x
   sequence_ xs

 -- or:
 sequence'_ = foldr () (return ())

They're defined once for all monads, not once for each monad, so in
some sense they behave the 'same' in that they use the Monad instance
in the same way.

It's just like, say, sort :: Ord a = [a] - [a] might do different
computations to compare elements depending on what 'a' is, but always
produces a sorted list regardless of that detail.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Package regex-posix-0.94.2 suddenly failed to link

2010-10-30 Thread Ben Millwood
On Sat, Oct 30, 2010 at 11:56 AM, Arnaud Bailly arnaud.oq...@gmail.com wrote:
 Hello,
 All of a sudden, the package regex-posix-0.94.2 failed to link after i
 installed a couple of other packages (http, json). When I try to
 reinstall it, I got the folowing errors:

 D:\projets\crete1941cabal install --global --reinstall
 --enable-documentation regex-posix-0.94.2
 Resolving dependencies...
 Configuring regex-posix-0.94.2...
 Preprocessing library regex-posix-0.94.2...
 Text\Regex\Posix\Wrap.hsc:107:19: regex.h: No such file or directory

This is the crucial line in this particular build failure, everything
else is fluff. I really, really wish gcc would learn to stop compiling
after a header file was missing, since it almost always results in
large amounts of nonsense errors.

It looks like cabal-install or possibly Cabal can't find your headers.
I notice you're compiling with an explicit --global option - why is
that? Is it currently installed locally or globally? You can use
'ghc-pkg list regex-posix' to check. You can also enable global
installs and documentation by default by editing your config file,
whose location is given in the output of cabal --help. You can also
specify extra-include-dirs there if you need to do that.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] who's in charge?

2010-10-29 Thread Ben Millwood
On Fri, Oct 29, 2010 at 5:06 AM, Steve Severance st...@medwizard.net wrote:
 whenever I here any open source community
 (yeah...everyone not just haskell) tell beginners to contribute a
 package I always scratch my head with a little bit of wonder. Would
 you really want a package that someone like me who is still trying to
 figure out how to utilize haskell's features would build? Do you want
 my outrageous non-use of the Monads that haskell offers?

Can I just take up this point and say, yes I do. It's much easier to
fix a bad library than write a good one :P

Besides, I'd think that often what Haskell developers lack is time
more than skill - there are plenty of tasks that could be done without
advanced knowledge of deep abstractions, if only someone could put
aside a few weekends for them. For example, writing low-level FFI
bindings is almost mechanical (i.e. requires basically no actual
ingenuity) with the right tools, but it takes time and effort, so
libraries go unbound.

In short, you do not need a PhD to write a decent and useful library!
Just open a github and give out commit access like confetti and
everything will be fine :)

I also think that it's a good idea to review Haskell packages more
thoroughly, but I think shiny-new-hackage is going to help a little in
that regard with reverse dependencies prominently visible on package
pages. I also think that it should be convention to link every hackage
package with a page on the wiki for discussion (perhaps creating a new
namespace in mediawiki for this purpose). This would be as simple as
adding an autogenerated link to hackage's template. This is not a new
idea, but it's yet to be popularised, and I think it needs backing
from Hackage itself to do that.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] type class design

2010-10-29 Thread Ben Millwood
On Fri, Oct 29, 2010 at 1:33 PM, Tillmann Rendel
ren...@informatik.uni-marburg.de wrote:

 Note that the case of (==) and (/=) is slightly different, because not only
 can (/=) be defined in terms (==), but also the other way around. The
 default definitions of (==) and (/=) are mutually recursive, and trivially
 nonterminating. This leaves the choice to the instance writer to either
 implement (==) or (/=). Or, for performance reasons, both.


I find these sorts of defaults deeply unsatisfying: particularly, suppose I do

newtype Foo = Foo Integer
  deriving (Eq, Show)

instance Num Foo where
  Foo a + Foo b = Foo (a + b)
  fromInteger = Foo

expr = Foo 3 - Foo 2

That I haven't defined implementations for (-) or negate will not even
get me a compiler warning, let alone a static error: it will just
stack overflow or spin endlessly on expr. This kind of bug is
notoriously difficult to track down.

I'm not sure how to handle this better, though. A compiler that
automatically calculated minimal complete definitions would be nice,
but relatively complicated. It might be more sensible to just take all
efficiency methods out of classes, and use a mechanism like rewrite
rules to give an efficient implementation where possible.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Current thinking on CompositionAsDot issue in haskell prime?

2010-10-28 Thread Ben Millwood
On Thu, Oct 28, 2010 at 11:12 AM, John Smith volderm...@hotmail.com wrote:
 On 28/10/2010 10:15, Alexander Kjeldaas wrote:

 Hi haskellers.

 Reading through the Haskell Prime suggestions, one that caught my eye is
 the CompositionAsDot issue.

 I'm especially thinking of the Pro issue:
 * Paves the way for using . as the selection operator in improved record
 or module systems


Here's the wiki page:
http://hackage.haskell.org/trac/haskell-prime/wiki/CompositionAsDot

Personally I think function composition is what Haskell is all about
and it is absolutely essential that the syntax for it be lightweight.
If we think using . as qualification as well as composition is
confusing, I'm much more inclined to say using it as qualification was
a mistake.

The comment on the wiki page about $ being more common in reality is
not even close to true for my own code, and I don't think I'm unusual
in that regard.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Test command line programs

2010-10-26 Thread Ben Millwood
On Tue, Oct 26, 2010 at 5:11 PM, Dupont Corentin
corentin.dup...@gmail.com wrote:
 Hello again café,

 I have a command line program that takes input from various handles
 (actually network sockets) like this:

 s - hGetLine h
 etc.

 I'd like to unit test this. How can I do?

If all you ever do in some part of the code is read from the socket,
consider passing an IO action to do that into your function, instead
of the handle itself.
Then:
a. you can easily replace the IO String with (return testdata), or a
read from an MVar you feed data into, or whatever else you like.
b. you can statically guarantee the function doesn't do anything
unexpected to the handle, like closing it or seeking or setting a
buffering option.
c. you will probably not have to write as much, saving on keyboard wear.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-20 Thread Ben Millwood
On Tue, Oct 19, 2010 at 2:32 PM, Michael Snoyman mich...@snoyman.com wrote:
 Algorithmic Problem Solving

I think this needs to go, because I'm really having a hard time
imagining any programmer who doesn't do this.

 High Assurance Software Development

This sounds vague to me and/or the same as other skills (cf. Formal
Verification). Again, I'm not sure how many people would describe
their software as low assurance.

 Robotics and Automation

Would be tempted to drop Automation from here.

 Web development (HTML, CSS and Javascript)

I wonder if these parentheses are necessary, or if they hint at the
fact that this isn't really one skill. I have a suspicion that being
competent at website and stylesheet *design* (i.e. knowledge of good
design principles and application to HTML/CSS) is an entirely
different sort of thing from *implementation* in terms of JavaScript
technologies like AJAX and JSON and who-knows-what.

Overall, I think it would be nice to have a consistent idea about how
concrete or abstract we allow skills to be, and as someone else
mentioned what the target audience is for them. We have skills that
relate to specific libraries and then skills that are nebulous and
abstract. Maybe we could ask a narrower question, or have two fields:
what can you use, and what interests you.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Proving stuff about IORefs

2010-10-17 Thread Ben Millwood
On Sun, Oct 17, 2010 at 11:15 AM, Malcolm Wallace
malcolm.wall...@me.com wrote:

 The problem with the code you originally posted was that it looked like
 this:

  f r = do r' - something
           f r'
           something else -- this is dead code

 That is, the computation is non-terminating, because f simply calls itself
 recursively, with no base case.

 Regards,
    Malcolm

He was using ==, not =, it was a statement of equality not a definition :)

Much like one might say that sort xs == sort (reverse xs).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] An interesting paper from Google

2010-10-16 Thread Ben Millwood
On Fri, Oct 15, 2010 at 9:28 PM, Andrew Coppin
andrewcop...@btinternet.com wrote:
 I'm still quite
 surprised that there's no tool anywhere which will trivially print out the
 reduction sequence for executing an expression. You'd think this would be
 laughably easy, and yet nobody has done it yet.


I tried to do something a bit like this:

http://github.com/benmachine/stepeval

but it could be charitably described as crude: has three failing
testcases and a bagful of unimplemented functionality.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Pronouncing Curry and currying

2010-10-08 Thread Ben Millwood
On Fri, Oct 8, 2010 at 8:56 AM, Petr Pudlak d...@pudlak.name wrote:
 thanks for both the explanation (Donn) and the sound sample (Luke).
 Unfortunately, hurry is pronounced differently in British and US English
 [1], so again I was a little bit confused :-). But Luke's sound sample made
 it clear for me.


I think curry is too - I would still pronounce it to rhyme with
hurry even though I have a British accent. I think in the presence
of accents it's not always sensible to look for a single correct
pronunciation - clarity of communication is the only really important
thing, and that will probably be maintained whatever you do with that
vowel.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Eta-expansion destroys memoization?

2010-10-07 Thread Ben Millwood
On Thu, Oct 7, 2010 at 1:44 PM, Luke Palmer lrpal...@gmail.com wrote:
 The section works because (a %^)  (for some operator %^) is short
 for (%^) a and (%^ a) is short for flip (%^) a.  Sections
 don't expand into lambdas.


According to the report they do:
http://haskell.org/onlinereport/exps.html#sections
http://haskell.org/onlinereport/haskell2010/haskellch3.html#x8-33.5

but GHC is different, I think:
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/syntax-extns.html#postfix-operators

I'm not sure if the significance of this difference is explored
anywhere, but notice that:

ghci (() `undefined`) `seq` ()
*** Exception: Prelude.undefined
ghci (`undefined` ()) `seq` ()
()
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Coding conventions for Haskell?

2010-09-28 Thread Ben Millwood
On Tue, Sep 28, 2010 at 5:55 AM, Evan Laforge qdun...@gmail.com wrote:

 I write haskell and python in a proportional font and it hasn't yet
 let to tabs, so no pain so far :)
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


I like writing proportional haskell, but I haven't worked out how to
do let-blocks in ways that look nice - the tactic I use for do and
where of breaking the line immediately tends to look a little odd,
especially if you're only making about one binding.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Applicative instances for Monads

2010-09-25 Thread Ben Millwood
On Sat, Sep 25, 2010 at 3:01 AM, Gregory Crosswhite
gcr...@phys.washington.edu wrote:
 ==

 import Control.Applicative
 import Control.Concurrent
 import Control.Concurrent.MVar

 newtype AIO a = AIO {unAIO :: IO a}

 instance Monad AIO where
   return = AIO . return
   (AIO x) = f = AIO (x = unAIO . f)

 instance Functor AIO where
    fmap f (AIO x) = AIO (fmap f x)

 instance Applicative AIO where
    pure = return
    (AIO mf) * (AIO ma) = AIO $ do
      f_box - newEmptyMVar
      forkIO (mf = putMVar f_box)
      a_box - newEmptyMVar
      forkIO (ma = putMVar a_box)
      f - takeMVar f_box
      a - takeMVar a_box
      return (f a)

 ==

This idea is pretty neat :) I think it should be found a place on the
wiki, or maybe even Hackage. The way in which it interacts with
exceptions, especially async exceptions, could be odd though, so it'd
be worth checking it pedantically adheres to the rules.

 To summarize:  on the one hand every Monad has a generic instance for
 Applicative, and yet on the other hand this instance is often arguably not
 the correct one because it ignores the fact that the second computation is
 independent of the first, which is a fact that can be exploited given
 additional knowledge about the structure of the Monad.

 I bring this up because there has been talk here of automatically having
 instances of Monad also be instances of Applicative, and what bugs me is
 that on the one hand this makes perfect since as every Monad can also be
 viewed as an Applicative, and yet on the other hand not only is there often
 more than one natural way to define an Applicative instance for selected
 Monads but furthermore the generic instance is often an inferior
 definition because it ignores the structure of the Monad.

I think what we learn from this is not that the Monad-based instance
of Applicative is necessarily the wrong one, but rather that there
is often more than one reasonable instance for a type, each suitable
for different uses. There are times when parallelisation is not a
priority, but determinism is, in which case we'd *want* the sequencing
of Monad even in the Applicative instance.

Often we use newtypes to distinguish between them (see: ZipList), and
if we accept that the Monad-based instance is always a useful one (and
if the Monad instance itself is useful I think it is) it makes sense
for it also to be the default one, so that we can have ap and *
always mean the same thing in the same context.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Problems with installing type-level package

2010-09-19 Thread Ben Millwood
2010/9/19 Николай Кудасов crazy.fiz...@gmail.com:
 Hi, cafe,
 I have a stange thing when trying to install type-level package:

 $ sudo ./Setup.hs configure
 Configuring type-level-0.2.4...
 $ sudo ./Setup.hs build
 Preprocessing library type-level-0.2.4...
 Building type-level-0.2.4...
 [1 of 8] Compiling Data.TypeLevel.Num.Reps ( src/Data/TypeLevel/Num/Reps.hs,
 dist/build/Data/TypeLevel/Num/Reps.o )
 [2 of 8] Compiling Data.TypeLevel.Num.Sets ( src/Data/TypeLevel/Num/Sets.hs,
 dist/build/Data/TypeLevel/Num/Sets.o )
 [3 of 8] Compiling Data.TypeLevel.Num.Aliases.TH (
 src/Data/TypeLevel/Num/Aliases/TH.hs,
 dist/build/Data/TypeLevel/Num/Aliases/TH.o )
 [4 of 8] Compiling Data.TypeLevel.Num.Aliases (
 src/Data/TypeLevel/Num/Aliases.hs, dist/build/Data/TypeLevel/Num/Aliases.o )
 Loading package ghc-prim ... linking ... done.
 Loading package integer ... linking ... done.
 Loading package base ... linking ... done.
 Loading package syb ... linking ... done.
 Loading package array-0.2.0.0 ... linking ... done.
 Loading package containers-0.2.0.1 ... linking ... done.
 Loading package pretty-1.0.1.0 ... linking ... done.
 Loading package template-haskell ... linking ... done.
 Generating and compiling a zillion numerical type aliases, this might take a
 while
 $ [...]

It looks like the Setup.hs build step is only compiling 4 of 8
modules? Does this stage appear to exit successfully?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO Put confusion

2010-09-16 Thread Ben Millwood
On Wed, Sep 15, 2010 at 12:45 AM, Chad Scherrer chad.scher...@gmail.com wrote:
 Hello,

 I need to be able to use strict bytestrings to efficiently build a
 lazy bytestring, so I'm using putByteString in Data.Binary. But I also
 need random numbers, so I'm using mwc-random. I end up in the IO Put
 monad, and it's giving me some issues.

 To build a random document, I need a random length, and a collection
 of random words. So I have
 docLength :: IO Int
 word :: IO Put

 Oh, also
 putSpace :: Put

 My first attempt:
 doc :: IO Put
 doc = docLength = go
  where
  go 1 = word
  go n = word  return putSpace  go (n-1)

I think you misunderstand, here, what return does, or possibly .
This function generates docLength random words, but discards all of
them except for the last one. That's what the  operator does: run
the IO involved in the left action, but discard the result before
running the right action.

The IO action 'return x' doesn't do any IO, so 'return x  a' does
nothing, discards x, and then does a, i.e.

return x  a = a

 Unfortunately, with this approach, you end up with a one-word
 document. I think this makes sense because of the monad laws, but I
 haven't checked it.

Yes, the above equation is required to hold for any monad (it is a
consequence of the law that 'return x = f = f x')


 Second attempt:
 doc :: IO Put
 doc = docLength = go
  where
  go 1 = word
  go n = do
    w - word
    ws - go (n-1)
    return (w  putSpace  ws)

 This one actually works, but it holds onto everything in memory
 instead of outputting as it goes. If docLength tends to be large, this
 leads to big problems.

Here you're using the  from the Put monad, which appends lazy
ByteStrings rather than sequencing IO actions. The problem is that the
ordering of IO is strict, which means that 'doc' must generate all the
random words before it returns, i.e. it must be completely done before
L.writeFile gets a look-in.

It turns out the problem you're trying to solve isn't actually simple
at all. Some of the best approaches to efficient incremental IO are
quite involved - e.g. Iteratees. But your case could be made a great
deal easier if you used a pure PRNG instead of one requiring IO. If
you could make word a pure function, something like word :: StdGen -
(StdGen, Put) (which is more or less the same as word :: State StdGen
Put), then you'd be able to use it lazily and safely.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Curious why cabal upgrade parsec not installing latest version

2010-09-16 Thread Ben Millwood
On Thu, Sep 16, 2010 at 4:00 AM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:
 Because Parsec-3 apparently still has some speed regressions compared
 to Parsec-2 (I'm not qualified to note whether its design is slow or
 if you have to use it differently to get good performance out of it),
 so many developers prefer to stick to Parsec-2 for this reason.

I thought Parsec 3.1 had pretty much caught up with the performance of parsec 2?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Idea for hackage feature

2010-09-16 Thread Ben Millwood
On Fri, Sep 17, 2010 at 1:44 AM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:
 On 17 September 2010 03:18, Henning Thielemann
 My suggestion is to move the Unsafe modules to a new package 'unsafe'.
 Then you can easily spot all dirty packages by looking at reverse
 dependencies of 'unsafe'.

 Hooray, yet another supposedly stand-alone library that GHC will
 depend on and thus can't be upgraded anyway, so there's no real
 advantage of making it stand-alone (after all, doesn't base use
 unsafeInterleaveIO or something for lazy IO?).


Well, it's not like we plan on regularly fiddling that API :)

The clever thing about this suggestion is that most packages don't
*export* equivalent power to unsafePerformIO even if they import it
(inlinePerformIO from bytestring is a notable exception) so you can
easily see from a library's *immediate* dependencies whether it could
potentially do anything naughty or not. Also, it's implementable
entirely with existing technology, although we'll probably want a
major base version bump to remove the modules.

When discussing this sort of taint I think it's important not to
forget that the FFI can be just as bad. For a start, one common use of
unsafe functions is to provide a pure API to a foreign library (as is
done in RWH), and clearly in such cases the proof of correctness
cannot exist in the language because it depends on properties of
libraries, which may not even be linked until runtime. Secondly, FFI
imports are almost as bad safetywise as System.IO.Unsafe, and twice as
impossible to prove correct. So your taint measure should take into
account use of that extension, too.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Scraping boilerplate deriving?

2010-09-15 Thread Ben Millwood
On Wed, Sep 15, 2010 at 2:11 PM, Kevin Jardine kevinjard...@gmail.com wrote:

 I do think that

 defObj(MyType)

 looks a bit cleaner than

 $(defObj MyType)


I believe as of GHC 6.12 you no longer need the $() around top-level
splices. So that would just be:

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


Re: [Haskell-cafe] Re: Cleaning up threads

2010-09-14 Thread Ben Millwood
On Tue, Sep 14, 2010 at 9:44 PM, Mitar mmi...@gmail.com wrote:
 Hi!

 On Tue, Sep 14, 2010 at 9:04 PM, Gregory Collins
 g...@gregorycollins.net wrote:
 That's surprising to me -- this is how we kill the Snap webserver
 (killThread the controlling thread...).

 Yes. This does work. The only problem is that my main thread then
 kills child threads, which then start killing main thread again, which
 then again kills child threads and interrupt cleanup.


This sounds wrong. Why is the main thread sending more than one kill?
Handlers for some exception shouldn't run more than once unless you
set them up that way.

Are you perhaps being tripped up by the issue whereby when the main
thread dies, the RTS just shuts down even if other threads are
running? You might find you need some kind of maybe MVar-driven
mechanism to keep the main thread alive until all else is definitely
dead.

Maybe this behaviour should be considered a bug, I don't know. It
would be nice if after a forkIO threads were effectively equal.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Do expression definition

2010-09-13 Thread Ben Millwood
On Mon, Sep 13, 2010 at 8:21 AM, Alexander Kotelnikov sa...@myxomop.com wrote:
 And, also, would it make any difference if


 do {p - e; stmts}      =       let ok p = do {stmts}
    ok _ = fail ...
  in e = ok

 is redefined as e = (\p - do {stmts})?

This is the magic that allows pattern-match failure in a do expression
to return a normal result. Notice that fail and not error is
called - each Monad has its own fail method, so that for example:

uncons :: [a] - Maybe (a, [a])
uncons xs = do { (x:xs) - return xs; return (x, xs) }

evaluates to Nothing rather than causing an exception when xs is empty.

That this implementation detail ends up in the Monad class is regarded
by many as untidy, though.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Disable LINE Pragma handling in GHC

2010-09-10 Thread Ben Millwood
On Fri, Sep 10, 2010 at 7:40 AM, JP Moresmau jpmores...@gmail.com wrote:
 I suppose even using GHC for building and something else
 (haskell-src-exts?) for code handling would leave us with compilation
 messages at the wrong place.

I don't quite understand your use case so I'm not sure it helps, but
for what it's worth haskell-src-exts allows you to ignore line pragmas
while parsing:

http://hackage.haskell.org/packages/archive/haskell-src-exts/1.9.0/doc/html/Language-Haskell-Exts-Parser.html#t:ParseMode
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Handling platform- or configuration-specific code (or, my CPP complaints)

2010-09-07 Thread Ben Millwood
Good evening, cafe,

Having recently taken on maintenance of a package that depends on
template-haskell, I've been in some discussion with users and
dependencies of my package about how best to write a library that
works with multiple incompatible versions of a dependency. The two
main approaches that I'm aware of are:
1. Use CPP and the macros defined by Cabal to conditionally include or
exclude code for each version.
2. Use Cabal file conditionals to select hs-source-dirs containing
those parts of the code (or even TH to help generate those parts of
the code) that are specific to each configuration.

In my discussion with others and examination of existing libraries, it
seems to me that 1. is the preferred option, but I personally can
think of a number of reasons to prefer the second option:
* CPP was not designed for Haskell, and even cpphs still shows
symptoms of it, so we have to worry about things like its handling of
string gaps or single quotes.
* CPP is primarily a textual manipulation tool, rather than a symbolic
one, which makes it even more easy to produce malformed code with it
than with TH or similar.
* On that note, it's difficult to statically analyse a file using CPP:
parser tools like haskell-src-exts don't support it and it's not at
all obvious how or if they ever could. With Cabal choosing source
files based on configuration, all the source is valid, normal Haskell
and is easy for computers and humans to understand.
* It may require some significant digging into each source file to
establish what configurations must be tested, or to add a new
supported configuration or remove an old one, if they are chosen based
on CPP conditional compilation. When Cabal chooses what is compiled it
is fairly explicit what is chosen and what could be, and adding a new
configuration is - at least in theory - as simple as adding a new file
and conditional.
* It's just not very pretty! Haskell code has a sort of aesthetic that
I don't think CPP macros share - different function application
syntax, for example.

Of course the trouble is that when your conditional compilation is on
the module level there are some things which just can't be done
without code duplication, and there's a tendency for small and often
quite incidental bits of a function definition to suddenly be in
another module instead of where they're used. So I wonder what people
think of the use of CPP in Haskell code, what alternatives people can
propose, or what people hope to see in future to make conditional
compilation of Haskell code more elegant and simple?

I once pondered whether it would be a good idea to somehow make
available to TH splices information from Cabal or GHC's configuration,
so that one could do something like this:

myFunctionDecl = if packageVersion template-haskell = Version [2, 4] []
  then [d| unTyVarBndr (PlainTV n) = n; unTyVarBndr (KindedTV n _) = n |]
  else [d| unTyVarBndr = id |]

This exactly wouldn't make sense because KindedTV wouldn't exist in
the earlier version so the quotation would object, but one could
imagine something similar being useful.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] How to catch exception within the Get monad (the Binary package)

2010-09-07 Thread Ben Millwood
On Tue, Sep 7, 2010 at 2:45 PM, Dimitry Golubovsky golubov...@gmail.com wrote:
 unThrow a = unsafePerformIO $ (E.evaluate a = return . Right) `E.catch`
                                               (\e - return $ Left e)

 -- or perhaps the right argument of catch could be just (return . Left)?

 bm2mb :: a - Maybe a

 bm2mb a = case unThrow a of
   Left (e::SomeException) - Nothing
   Right a - Just a

Philosophically these functions are Nasty because they violate
referential transparency. In particular it's possible for the same
expression to throw different exceptions each time it's run depending
on how it's optimised, what other threads are doing, if the user
presses ctrl-C, etc. etc.
See the spoon package:

http://hackage.haskell.org/package/spoon

which alleviates this a little by only catching some kinds of
exception, and not telling you which it caught. It still violates
monotonicity (I believe), so purists will be upset, but practically it
can be useful for when editing the source code to provide explicit
exceptions (which is ideally what you'd do) is not an option.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Restricted type classes

2010-09-04 Thread Ben Millwood
I have only one thing to add to this discussion:

On Fri, Sep 3, 2010 at 5:16 AM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:
 2b) Is it OK to promote functions that use a class to being class
 methods?  When I was discussing this in #haskell several people
 mentioned that defining something like liftA2 for the Set instance of
 (restricted) Applicative would make more sense than the default *
 (since (a - b) isnt' an instance of Ord).

One problem with defining both * and liftA2 in the class in terms of
each other is that omitting them from instances is no longer a
compile-time error, nor is it even an obvious runtime error - it's
frequently an infinite loop, which is unpleasant. Though I understand
that it's nice to be able to choose the methods you want to define, I
think static error detection is nice too, so I tend to avoid providing
extra class methods with defaults unless the alternative is much
worse.

On that note, why *do* we have missing instance methods filled in with
bottoms, so that even without defaults, it's a warning rather than an
error? It seems like quite an un-Haskelly thing to do. I know there
may be some cases where you do not need to define a particular method,
but imo you should be required to explicitly opt out of it if that's
the case.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] creating a type based on a string

2010-09-02 Thread Ben Millwood
On Thu, Sep 2, 2010 at 9:31 PM, Andrew U. Frank
fran...@geoinfo.tuwien.ac.at wrote:
 I have a user input (string) and need to select one of two types.
 depending what the input is. is this possible?

 data A
 data B

 data X n = X String

 op :: String - X n
 op a = X a :: X A
 op b = X b :: X B

 this does obviously not compile. is there a way to achieve that the type
 X A is produced when the input is a and X B when the input is b?

 thank you for help!
 andrew


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


Here's another way of not quite doing what you want:

op :: String - Either (X A) (X B)
op a = Left (X a)
op b = Right (X b)

which is roughly how I translate the recent discussion about
type-level validity certification:
http://www.haskell.org/pipermail/haskell-cafe/2010-August/082899.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Handling absent maintainers

2010-08-18 Thread Ben Millwood
2010/8/17 Geoffrey Mainland mainl...@eecs.harvard.edu:
 On 08/17/2010 12:28, Ben Millwood wrote:
 2010/8/17 Jonas Almström Duregård jonas.dureg...@gmail.com:
 Hi,

 Has there been any progress with this package? Like you I have also
 tried to contact Matt and like you I have ended up making my own
 version of src-meta :). When someone assumes maintainership of this
 package I would like to discuss integrating some additions I made to
 the Translation module.

 /Jonas


 Hi Jonas,

 Sorry about the delay. In my version of haskell-src-meta I basically
 replaced the entire Language.Haskell.TH.Instances.Lift module with
 derivations from the th-lift package whose latest version currently
 doesn't build [1]. I had been in contact with the maintainer of the
 package who has prepared a version 0.5 and was waiting for them to
 upload it so that I could use it as a dependency, but I haven't heard
 from them in a week or so. I'll try emailing them again, and as soon
 as 0.5 is on hackage I will go ahead with my upload.

 I suppose since there's no reason why I deserve maintainership more
 than you you could just go ahead and upload your version instead. You
 can see exactly what I've done at my github repository [2].

 Yours,
 Ben Millwood

 [1] http://hackage.haskell.org/package/th-lift-0.4
 [2] http://github.com/benmachine/haskell-src-meta

 I'm also waiting on a 6.12-compatible version of haskell-src-meta so I
 can release a version of my package for quasiquoting C/CUDA. I pulled
 Mark's changes to create a version that maintains compatibility with
 version 2.3 of the template-haskell library (and therefore with GHC
 6.10). Is there any chance we can keep backwards-compatibility? ;) I'm
 happy to help with patches and/or maintainership, of course.

 Geoff


I imagine maintaining compatibility across template-haskell versions
might be tricky. Prior to template-haskell-2.4.0.0, I believe there
was no TH support for kinds, and class contexts were simply Types
rebranded (not supporting equality constraints). So some
not-inconsiderable sections of code would need duplication, or we'd
need to deal with CPP which always struck me as a fragile and
inelegant solution. Of course, I welcome the patches to prove me wrong
:) or well, if you just want to take maintainership yourself, the
package is really as much yours as it is mine at this stage.

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


Re: [Haskell-cafe] A cabal odyssey

2010-08-18 Thread Ben Millwood
On Wed, Aug 18, 2010 at 8:31 AM, Evan Laforge qdun...@gmail.com wrote:
 I was trying to turn on --global by default

user-install: False

I think it's not completely a stupid idea to have profiling default
off. I personally do not really enjoy the fact that I compile
everything three times nowadays :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANNOUNCE: haskell-src-meta 0.1.0

2010-08-18 Thread Ben Millwood
Hello cafe,

The haskell-src-meta package was originally written by Matt Morrow, to
provide a translation from the syntax tree parsed from String by the
haskell-src-exts package to Template Haskell's representation of
Haskell source code, making possible a variety of interesting
quasiquoters and metaprogramming.

However, while the package was still fairly embryonic and incomplete,
Matt disappeared from the haskell community, and his work no longer
compiles with the latest versions of template haskell and GHC. Many
people still had use for it, so there was some discussion about its
future in a haskell-cafe thread [1] resulting in a fork [2]. After I
and at least one other person duplicated the work of updating
haskell-src-meta, ignorant of the fork, it was decided that
maintaining forks was a less-than-ideal solution, so I volunteered to
take up maintainership of a package that had by now been untouched for
some ten months.

Hence, haskell-src-meta-0.1.0, from a new maintainer (hello!). The
functionality changes in this release are minimal, but nonzero: its
primary purpose is to let the original work be used with updated TH.
However, there have been some changes and additions since 0.0.6:

* The previously somewhat lengthy Language.Haskell.TH.Instances.Lift
is now mostly generated with template haskell using the th-lift
package.
* Contexts, kinds, bang patterns, unboxed word literals, newly
supported in template-haskell-2.4.0.0, are used where necessary.
* Use of haskell-src-exts is brought in line with newer versions.
* Thanks to a patch by Jonas Duregard, a new ToDecs class has been
added to handle cases where more than one Dec must be returned.

I don't have any big plans for future releases: there is a lot that
could do with tidying up, and some small aspects of the syntax
conversion that aren't covered, but I mostly just intend to ensure it
keeps building and that anyone with patches to contribute has a prompt
response.

How You Can Help: the easiest way is to tell me that I've put the
version constraints too tightly on some dependency or other -- I have
erred on the conservative side. Any other comments on the package in
general are appreciated too, since this is the first time I've ever
uploaded anything to Hackage. There is a github repository at
http://github.com/benmachine/haskell-src-meta if you want to submit
patches.

Yours sincerely,
Ben Millwood

[1] http://www.haskell.org/pipermail/haskell-cafe/2010-July/080390.html
[2] http://hackage.haskell.org/package/haskell-src-meta-mwotton
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Handling absent maintainers

2010-08-17 Thread Ben Millwood
2010/8/17 Jonas Almström Duregård jonas.dureg...@gmail.com:
 Hi,

 Has there been any progress with this package? Like you I have also
 tried to contact Matt and like you I have ended up making my own
 version of src-meta :). When someone assumes maintainership of this
 package I would like to discuss integrating some additions I made to
 the Translation module.

 /Jonas


Hi Jonas,

Sorry about the delay. In my version of haskell-src-meta I basically
replaced the entire Language.Haskell.TH.Instances.Lift module with
derivations from the th-lift package whose latest version currently
doesn't build [1]. I had been in contact with the maintainer of the
package who has prepared a version 0.5 and was waiting for them to
upload it so that I could use it as a dependency, but I haven't heard
from them in a week or so. I'll try emailing them again, and as soon
as 0.5 is on hackage I will go ahead with my upload.

I suppose since there's no reason why I deserve maintainership more
than you you could just go ahead and upload your version instead. You
can see exactly what I've done at my github repository [2].

Yours,
Ben Millwood

[1] http://hackage.haskell.org/package/th-lift-0.4
[2] http://github.com/benmachine/haskell-src-meta
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] A cabal odyssey

2010-08-17 Thread Ben Millwood
On Mon, Aug 16, 2010 at 8:27 PM, Andrew Coppin
andrewcop...@btinternet.com wrote:
 The amusing part is, if you sudo cabal
 install so it has permission to put the installed files into place, it then
 uses root's configuration file instead. *sigh* Well anyway, I managed to
 work around that. But... Cabal *still* fails to find Alex or Happy, even
 though they're now in the search path.

 Oh, wait. They're in *my* search path. They're not in root's search path.
 [...]

It sounds to me like your life would be a lot easier if you knew about
cabal-install's root-cmd configuration parameter! Open your
.cabal/config file and uncomment and set:

root-cmd: sudo

Now cabal-install will take up root permissions when and only when necessary :)
I only found this out after asking #haskell about similar problems.
Perhaps it should be more prominent somehow.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Unwrapping long lines in text files

2010-08-14 Thread Ben Millwood
On Sat, Aug 14, 2010 at 2:38 AM, michael rice nowg...@yahoo.com wrote:

 The program below takes a text file and unwraps all lines to 72 columns, but 
 I'm getting an end of file message at the top of my output.

 How do I lose the EOF?

 Michael


While many other people have shown you why you need not necessarily
answer this question, I think it'd be helpful for you to hear the
answer anyway.
Your message is being produced because you are trying to getLine when
there is no input left. This raises an exception, which, because it is
not handled by your program, prints a diagnostic message and exits.
Strangely, it prints this before the output of your program - this
isn't terribly important, but for the sake of completeness, it's
because of the different buffering characteristics of stdout and
stderr, which confusingly mean that even though your program produces
output and then produces an error, the error is printed immediately
while the output waits until the program is terminated to be produced.
I think. Something like that, anyway.

So, how do you avoid the exception? You can use System.IO.isEOF [1] to
check if there is input available on the standard input handle:

main = do
  eof - isEOF
  when (not eof) realMain
  -- when from Control.Monad, see also: unless
 where
  realMain = do realStuff

Or you can let getLine throw the exception, but catch it and deal with
it yourself, rather than letting it kill your program.
Catching it is a little less simple, but is considerably more flexible
and powerful. The exceptions situation in Haskell is somewhat
complicated by the fact that the mechanism used by haskell98 has been
improved upon, but the new extensible mechanism is incompatible with
the old so both have to hang around. Have a look at Control.Exception
[2] and System.IO.Error [3]. In either case you have 'catch' as a sort
of basic operation, and more convenient things like 'try' which sort
of turn an exception into a pure Either result. I'd do something like
this:

main = do
  result - try getLine
  case result of
Left err - return () -- or do something diagnostic
Right  - putStrLn   main
Right line - doStuffWith line

On a more general note, your main function looks a little suspect
because it *always* recurses into itself - there's no termination
condition. A question nearly as important as how does my program know
what to do is how does it know when to stop :)

[1] 
http://hackage.haskell.org/packages/archive/base/4.2.0.1/doc/html/System-IO.html#v%3AisEOF
[2] 
http://hackage.haskell.org/packages/archive/base/4.2.0.1/doc/html/Control-Exception.html
[3] 
http://hackage.haskell.org/packages/archive/base/4.2.0.1/doc/html/System-IO-Error.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Preview the new haddock look and take a short survey

2010-08-06 Thread Ben Millwood
On Thu, Aug 5, 2010 at 2:35 PM, Dino Morelli d...@ui3.info wrote:

 One thing I haven't seen anyone else comment on is the width of the new
 docs. I have a large (26) monitor and use the browser full-screen (with
 xmonad, so even more screen space). When I load these pages, particularly
 the non-frame one, something like 50% of my screen real-estate is empty
 whitespace on either side of the doc content. There is also wasted space
 in the frames version, just a little less of it. I wish the docs were
 using that space like the current Haddock does. Is the plan to use a
 fixed width like this?

 Please say no, it's a disappointing trend that you see everywhere. Like
 Twitter's web interface, for instance, very narrow.


Yeah, I wrote about this in my survey response. It seems to me that if
I find text in a narrow page more readable, I can easily just resize
my browser window, this doesn't need to be enforced by the webpage
itself.

I'm also not so enthusiastic about tabbed synposis. I'm not convinced
you can easily use the synopsis and doc text simultaneously, so I
don't see any reason for it to be apart from the text body. Simplicity
is a virtue :)

I do think that in terms of colours, fonts etc. it's prettier, but the
fixed max width and kind of gimmicky synopsis tab are steps backward
in my opinion.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Handling absent maintainers

2010-08-05 Thread Ben Millwood
On Thu, Aug 5, 2010 at 5:07 AM, Erik de Castro Lopo
mle...@mega-nerd.com wrote:

 The permissiveness of hackage uploads suggests that Hackage needs
 to start using something like GPG signing and GPG webs of trust.

 The Debian project has stuff like this in place and I'm sure this
 community could learn a lot from what Debian is currently using.

 Erik

It's worth mentioning that Hackage accounts aren't just given out for
free - one has to specifically request them, and they can presumably
just as easily be revoked.

Thanks Mark, I'll request a Hackage account within the next couple of
days and then make the upload.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Handling absent maintainers

2010-08-05 Thread Ben Millwood
On Thu, Aug 5, 2010 at 6:38 PM, Ben Millwood hask...@benmachine.co.uk wrote:

 It's worth mentioning that Hackage accounts aren't just given out for
 free - one has to specifically request them

Er, to clarify, I mean signup can't be automated, because account
creation is done by a human. Not that hackage charges for accounts or
something.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Handling absent maintainers

2010-08-03 Thread Ben Millwood
On Sun, Jul 18, 2010 at 3:02 AM, Mark Wotton mwot...@gmail.com wrote:

 I've uploaded haskell-src-meta-mwotton, using the development version.
 It seems to work fine for my applications. It's a bit of a hack, but I
 can't think of a better way to do it for now.

 mark


 --
 A UNIX signature isn't a return address, it's the ASCII equivalent of a
 black velvet clown painting. It's a rectangle of carets surrounding a
 quote from a literary giant of weeniedom like Heinlein or Dr. Who.
         -- Chris Maeda
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


I've just come up against one of the drawbacks of this approach -
having needed haskell-src-meta for a personal project, I downloaded
the source and updated it to work with GHC 6.12, fixed various bits
and bobs, and only now found out that much of that work had already
been done elsewhere :)

Matt Morrow has been missing for a long time and I think it's
reasonable to suppose he won't suddenly spring out of the darkness to
fix things for us. I propose that someone just take up maintainership
of the package. I am quite willing to do this with my version, or Mark
if you think you'd like to keep a closer eye on your dependencies you
could do it instead.

I further propose that we should write up a haskellwiki page about
absent maintainers and what the community thinks is reasonable in
terms of attempting contact before assuming them missing, presumed
gone. This kind of depends also on how big an indignity we consider it
to be if someone updates a package while the maintainer is just on
holiday or something.

So we need to decide on: first, who will take haskell-src-meta, and
second, what we think is good as a more general policy. I would think
the process would go something like:
1. email maintainer, wait 2 weeks for reply
2. email cafe and maintainers of reverse dependencies with proposed
changes, wait a week or so for people who know the maintainer to show
up or other people to object to your changes
3. chomp package
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Constructor question

2010-07-31 Thread Ben Millwood
On Sat, Jul 31, 2010 at 2:32 PM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:

 Forcing; it means that the values are evaluated (up to WHNF) before the
 Complex value is constructed:

 http://www.haskell.org/ghc/docs/6.12.1/html/users_guide/bang-patterns.html


Actually, this isn't a bang pattern: the 'a' here is not a pattern,
it's a type variable. Strictness flags in data declarations are a
haskell98 feature.

See:

http://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-680004.2

the paragraph on Strictness Flags a little way down that page.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Laziness question

2010-07-31 Thread Ben Millwood
On Sat, Jul 31, 2010 at 4:56 PM, michael rice nowg...@yahoo.com wrote:

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


 Given two functions of one parameter, f and g, we say f is stricter than g if 
 f x evaluates x to a deeper level than g x

 Exercises

    1. Which is the stricter function?

 f x = length [head x]
 g x = length (tail x)



 Prelude let f x = length [head x]
 Prelude let g x = length (tail x)
 Prelude f undefined
 1
 Prelude g undefined
 *** Exception: Prelude.undefined
 Prelude



 So, g is stricter than f?

 Wouldn't both functions need to evaluate x to the same level, *thunk* : 
 *thunk* to insure listhood?

 f x = length [head *thunk* : *thunk*]
 g x = length (tail *thunk* : *thunk*)

 Michael


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


Notice the two different kinds of brackets being used in f versus g :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Laziness question

2010-07-31 Thread Ben Millwood
On Sat, Jul 31, 2010 at 5:59 PM, michael rice nowg...@yahoo.com wrote:

 OK, in f, *length* already knows it's argument is a list.

 In g, *length* doesn't know what's inside the parens, extra evaluation there. 
 So g is already ahead before we get to what's inside the [] and ().

According to the types, we already know both are lists. The question
is, of course, what kind of list.

 But since both still have eval x to *thunk* : *thunk*,  g evaluates to a 
 deeper level?

 Michael


I think this question is being quite sneaky. The use of head and tail
is pretty much irrelevant. Try the pointfree versions:

f = length . (:[]) . head
g = length . tail

and see if that helps you see why f is lazier than g.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Definition of List type?

2010-07-30 Thread Ben Millwood
On Fri, Jul 30, 2010 at 7:50 PM, Gregory Crosswhite
gcr...@phys.washington.edu wrote:

 The reason why this definition never actually appears is because it defines 
 the constructors using operators rather than names, which is not allowed in 
 vanilla Haskell.  (There is an extension, TypeOperators, however, that does 
 allow this.)


 Nope: see Data.Complex.Complex; only infix *type* constructors are
nonstandard. The thing about lists that makes them impossible to
define in normal Haskell is the [a] syntax, which is some kind of
outfix type constructor, which no amount of currently available
extensions will allow. In addition, the constructor [] for the empty
list isn't a normal constructor, syntactically, because it doesn't
start with an uppercase character or a colon.

Basically, lists are so ubiquitous in Haskell that they have their own
special syntax, which cannot be defined like any other data type. It
is simple, as others have said, to define a new data type that works
identically to lists.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Definition of List type?

2010-07-30 Thread Ben Millwood
On Fri, Jul 30, 2010 at 8:54 PM, michael rice nowg...@yahoo.com wrote:

 Thanks all,

 Now that I have a (very) rudimentary understanding of Haskell, I figured I'd 
 back up and have a closer (conceptual) look at type definitions to see what 
 they have in common, and just happen to pick Maybe and List.

 I also noticed Maybe has a list of Instances

 Monad Maybe
 Functor Maybe
 Typeable1 Maybe
 MonadFix Maybe
 MonadPlus Maybe
 etc.

 while List has none, at least I don't see any in Data.List. Same reason?

 From Learn You A Haskell:

 If a type is a part of a typeclass, that means it supports and implements 
 the behavior the typeclass describes.

 I'm way out on a limb here, but isn't Monad a typeclass? and if, as we say 
 above, that Maybe is an instance of Monad, wouldn't there have to be

 instance Monad Maybe where
  return = ...  -- return for Maybe
  = = ... -- bind for Maybe
  etc.

 somewhere? Where? It's not in Data.Maybe. Is there some kind of scheme for 
 defining this stuff, i.e., this goes here, that goes there?


It *is* in Data.Maybe:

http://hackage.haskell.org/packages/archive/base/4.2.0.1/doc/html/src/Data-Maybe.html

Generally speaking a type class instance should go either where the
type is defined, or where the class is defined, although there are
exceptions. In any case, if you can get the instance loaded in ghci,
you can find out where its defined:

ghci :i Maybe
data Maybe a = Nothing | Just a -- Defined in Data.Maybe
instance (Eq a) = Eq (Maybe a) -- Defined in Data.Maybe
instance Monad Maybe -- Defined in Data.Maybe
instance Functor Maybe -- Defined in Data.Maybe
instance (Ord a) = Ord (Maybe a) -- Defined in Data.Maybe
instance (Read a) = Read (Maybe a) -- Defined in GHC.Read
instance (Show a) = Show (Maybe a) -- Defined in GHC.Show
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Memory and Threads - MVars or TVars

2010-07-29 Thread Ben Millwood
On Thu, Jul 29, 2010 at 3:49 AM, Eitan Goldshtrom
thesource...@gmail.com wrote:
 Perhaps you guys could help me with Cabal now though? I'm
 trying to install Orc but it wants base=4.2 and =4.3 and I have 4.1 after
 installing the latest release of GHC. Cabal won't upgrade the base. It
 complains about a dependency to integer-simple. Anyone know what that's
 about?


The latest version of GHC (6.12) comes with base 4.2. In general, base
versions are tied to compiler versions, and you can't upgrade base on
its own.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] MonadLib usage

2010-07-19 Thread Ben Millwood
On Sun, Jul 18, 2010 at 5:59 PM, Emil Melnikov emilm...@gmail.com wrote:
 On 2010, July 18, 23:27
 Ivan Lazar Miljenovic ivan.miljeno...@gmail.com wrote:

 When discussing a similar issue with Manuel Chakravarty, he convinced me
 that cunning newtype deriving is actually rather bad in practice and
 shouldn't be used as there's a lack of proofs or some such (I can't
 remember the arguments, but I remember being convinced by them :p).

 Hmm...  I can't imagine how it is possible, since new and
 original types are isomorphic.

 Can you give me some pointers to this discussion (links or
 keywords)?


They are isomorphic, but distinct. This trac ticket is relevant:

http://hackage.haskell.org/trac/ghc/ticket/1496
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] bug in ghci ?

2010-07-08 Thread Ben Millwood
On Thu, Jul 8, 2010 at 3:45 PM, Daniel Fischer daniel.is.fisc...@web.de wrote:

 Well, I made the suggestion of emitting a warning on instance declarations
 without method definitions. That would be comparatively easy to implement
 (even with an additional check to only emit the warning if the class
 defines any methods) and catch many (if not most) cases.


Unfortunately, it would catch some perfectly valid cases, see the list
of instances for flat datatypes here:

http://hackage.haskell.org/packages/archive/deepseq/1.1.0.0/doc/html/src/Control-DeepSeq.html

This demonstrates that there is at least one (admittedly probably not
much more than one) case where a class with methods would have a
default implementation that was total and valid in some cases.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Is my code too complicated?

2010-07-05 Thread Ben Millwood
On Mon, Jul 5, 2010 at 2:41 PM, Ertugrul Soeylemez e...@ertes.de wrote:
 Yes, there is some performance loss because of wrapping/unwrapping, but
 I think this loss is neglible for most applications.  And I'd ask
 anyway.  This is a discussion thread after all. =)


Pretty much all monad transformers are implemented as newtypes, so the
wrapping and unwrapping operations themselves should get compiled into
nothing, I think. It may be that the extra type faff makes inlining or
other arcane optimisations less straightforward, but I see no reason
to assume that monad transformers are necessarily even slightly slower
than explicitly-constructed amalgamations.

In my experience, something like ReaderT Params (StateT SessionData
IO) a may *look* scary, but in all your code you just use ask and put
and get anyway and they all work like magic - the difficult bits are
generally speaking hidden in your type synonyms and run function.

But then, my largest haskell projects have never been more than a
thousand or so lines, so perhaps it's just an issue of scale.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: Sifflet visual programming language, release 0.1.7

2010-06-12 Thread Ben Millwood
On Sat, Jun 12, 2010 at 9:05 PM, Daniel Fischer
daniel.is.fisc...@web.de wrote:
 On Saturday 12 June 2010 21:43:25, gdwe...@iue.edu wrote:
 so I go on declaring in my cabal file
 that my package depends on P = A.B.C,
 even though I *might* be using new features of P
 that wouldn't work with P == A.B.C.

 If you're changing the code to use new features of P, you have to raise the
 lower bound of the dependency.
 If you don't use any new features, it would continue working with P-A.B.C,
 so you can leave the lower bound.


It's not always easy to remember or tell when you break compatibility
with old versions. I came up with this idea for cabal-install to aid
in development:

http://hackage.haskell.org/trac/hackage/ticket/661

which I think would help, but it's not been written yet. Maybe add
yourself to the CC list if you're eager to see it happen.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: GATD and pattern matching

2010-06-11 Thread Ben Millwood
On Fri, Jun 11, 2010 at 12:46 AM, Felipe Lessa felipe.le...@gmail.com wrote:

  eqTypeable :: (Typeable a, Eq a, Typeable b, Eq b) = a - b - Bool
  eqTypeable x y = case cast y of
                     Just y' - x == y'
                     Nothing - False


...or indeed:

eqTypeable x y = cast x == Just y
___
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 Ben Millwood
On Thu, Jun 10, 2010 at 8:57 PM, Maciej Piechotka uzytkown...@gmail.com 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


Re: [Haskell-cafe] Re: Problems with Haskell Platform

2010-06-02 Thread Ben Millwood
On Wed, Jun 2, 2010 at 12:37 PM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:

 Is there a way of making Cabal install dependencies using the system
 package manager, then?

 For example, I might ask Cabal to install package A.  Package A
 depends on B and C.  A package for B can be downloaded through APT,
 but there are no APT-installable candidates for A and C.  Are you
 saying that Cabal can download and install B using APT, then download
 A and C from Hackage?

 If you mean cabal-install, then no, there's no integration on either
 side.


It's worth noting, though, that cabal-install doesn't track installed
packages itself, GHC does. So if you install a library from APT and it
writes to the package.conf correctly, cabal-install will be able to
find it.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] TDD in Haskell

2010-05-25 Thread Ben Millwood
On Tue, May 25, 2010 at 12:36 PM, Ionut G. Stan ionut.g.s...@gmail.com wrote:

 Oh, and a small off-topic question? Is it considered a good practice to use
 implicit imports in Haskell? I'm trying to learn from existing packages, but
 all those import all statements drive me crazy.


It's pretty common but I don't like it. Whenever I have to debug
someone else's code usually the first thing I'll do is make all the
import lists explicit so I can work out where a troublesome function
is coming from, and that's a bit of a waste of time.

In some cases though it can get a little silly. Here is an import
statement from one of my projects:

import Language.Haskell.Exts (
 Alt (Alt),
 Binds (BDecls),
 Decl (PatBind, FunBind, InfixDecl),
 Exp (App, Case, Con, Do, If, InfixApp, Lambda, LeftSection,
  Let, List, Lit, Paren, RightSection, Tuple, Var, XPcdata),
 GuardedAlt (GuardedAlt),
 GuardedAlts (UnGuardedAlt, GuardedAlts),
 Literal (Char, Frac, Int, String),
 Match (Match),
 Op (ConOp, VarOp),
 Pat (PApp, PInfixApp, PList, PLit, PParen, PTuple, PVar, PWildCard),
 Name (Ident, Symbol),
 QName (Special, UnQual),
 QOp (QConOp, QVarOp),
 Rhs (UnGuardedRhs),
 SpecialCon (Cons),
 SrcLoc (), -- (SrcLoc),
 Stmt (Generator, LetStmt, Qualifier),
 preludeFixities,
 prettyPrint
 )

...there comes a certain point where one can probably leave the
biggest import implicit, on the basis that if it's from nowhere else,
it's probably there.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Bug with [Double]

2010-05-19 Thread Ben Millwood
On Wed, May 19, 2010 at 10:57 AM, Serguey Zefirov sergu...@gmail.com wrote:

 PS
 Rationals:
 Prelude [1,1+2/3..10] :: [Rational]
 [1 % 1,5 % 3,7 % 3,3 % 1,11 % 3,13 % 3,5 % 1,17 % 3,19 % 3,7 % 1,23 %
 3,25 % 3,9 % 1,29 % 3,31 % 3]

 Same result.

This sounds like a bug to me. The section of the Haskell Report that
deals with the Enum class mentions Float and Double, not Rational, and
there's really no sensible reason why Rationals would exhibit this
behaviour given that they don't have rounding error.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GADTs and Scrap your Boilerplate

2010-05-16 Thread Ben Millwood
On Sun, May 16, 2010 at 2:34 AM, Tom Hawkins tomahawk...@gmail.com wrote:
 I got the GADT

 data DataBox where
   DataBox :: (Show d, Eq d, Data d) = d - DataBox

 [snip]

 but I can't figure out how to implement gunfold for DataBox.

 The error message is

 Text/XML/Generic.hs:274:23:
     Ambiguous type variable `b' in the constraints:

 I had a similar difficultly in Atom making a GADT a member of Eq.  At
 one point I had my head wrapped around the reason for the problem, but
 now it escapes me.  However, I remember the solution: I created a
 function to convert the GADT into another, unGADT type, which was then
 used to compute (==).
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


Have you tried using StandaloneDeriving (and DeriveDataTypeable)?

According to 
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/deriving.html#stand-alone-deriving
you can't derive instances for GADTs normally but a standalone
derivation will at least attempt to make an instance as if it was an
ordinary data type.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-09 Thread Ben Millwood
On Sun, May 9, 2010 at 7:27 AM, wren ng thornton w...@freegeek.org wrote:

 The only examples I can think of where we'd want 'fail'-able patterns are
 entirely pedagogical (and are insignificantly altered by not using
 'fail'-able patterns). I can't think of any real code where it would
 actually help with clarity.


You're not a fan of e.g.

catMaybes xs = [x | Just x - xs]

or the do-notation form:

catMaybes xs = do
 Just x - xs
 return x

then? (I actually prefer foldr (maybe id (:)) [] but that's probably just me :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-08 Thread Ben Millwood
On Sat, May 8, 2010 at 3:26 AM, John Meacham j...@repetae.net wrote:

 What counts as unfailable?

 (x,y) probably,  but what about

 data Foo = Foo x y

 If we don't allow it, we add 'magic' to tuples, which is a bad thing, if
 we do allow it, there are some odd consequences.

 adding another constructor to Foo will suddenly change the type of do
 notations involving it non locally. said constructor may not even be
 exported from the module defining Foo, its existence being an
 implementation detail.

 All in all, it is very hacky one way or another. Much more so than
 having 'fail' in Monad.


This is an interesting point, but I still disagree. A data type having
constructors added or changed *is* going to break code in clients
using it, or at least make GHC spit out a bunch of non-exhaustive
warnings. It's then a good idea, I think, that people are forced to
re-examine their use sites which don't obviously handle the new
failing case. Presumably if they were really really sure then just a
few well-placed ~s would make the problem go away.
(i.e. to answer your question, pattern matching against any
single-constructor data type should be unfailable in my opinion).

On Sat, May 8, 2010 at 7:16 AM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:
 As I said in another email: does not the x - Nothing itself call fail
 as it expects x to be an actual value wrapped in Just?

No, the propagation of Nothings is done solely by the definition of
= for Monad, and doesn't need fail at all.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Would it be evil to add deriving Typeable to newtype Q?

2010-05-06 Thread Ben Millwood
On Thu, May 6, 2010 at 4:05 AM, Ivan Miljenovic
ivan.miljeno...@gmail.com wrote:
 Re-CC'ing -cafe:

 On 6 May 2010 12:54, Leonel Fonseca leone...@gmail.com wrote:
 I wasn't aware of GeneralizedNewtypeDeriving.
  I just edited the source file Language.Haskell.TH.Syntax
 and left:

 newtype Q a = Q { unQ :: forall m. Quasi m = m a }
    deriving Typeable

 Hang on, is Q something actually in the template-haskell library?  In
 that case, you can't just do deriving (Typeable) .


{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}

import Data.Typeable
import Language.Haskell.TH

deriving instance Typeable1 Q

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


Re: [Haskell-cafe] {-# LANGUAGE DeriveApplicative #-} ?

2010-05-06 Thread Ben Millwood
On Thu, May 6, 2010 at 8:55 AM, Pavel Perikov peri...@gmail.com wrote:
 Hi, list!.

 Now in 6.12.1 we have DeriveFunctor, DeriveFoldable and DeriveTraversable. 
 This greatly simplifies the reuse structure style of programming. Some 
 structure (not just _data_ structure) got captured in ADT and can be reused 
 for various purposes.

 Wouldn't it be nice to have the ability to derive Applicative as well? It 
 shouldn't be more difficult than deriving Functor but will provide exciting 
 possibilities. Just think about liftA2.


The difference is that there is at most one law-abiding instance of
Functor for each type, whereas there are in principle multiple
possible instances for Applicative for a type. E.g. the following:

instance Applicative [] where
 pure x = [x]
 fs * xs = concatMap (\f - map f xs) fs

instance Applicative [] where
 pure = repeat
 (f:fs) * (x:xs) = f x : fs * xs
 _ * _ = []

are both law-abiding instances (although only one has a corresponding
law-abiding Monad, I believe). Which should GHC choose?
It's worth noting, though, that there are other derivable classes that
don't have a single implementation. It's a question of trading off
complexity of the compiler versus saved effort in code versus
additional clarity in code, I think.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] mixing map and mapM ?

2010-05-06 Thread Ben Millwood
On Thu, May 6, 2010 at 11:51 AM, Bill Atkins watk...@alum.rpi.edu wrote:
 Almost - liftM modificationTime has type Status - IO EpochTime.  Like
 other IO functions (getLine, putStrLn), it returns an IO action but accepts
 a pure value (the modification time)

ghci :m +Control.Monad System.Posix.Files
ghci :t liftM modificationTime
liftM modificationTime
  :: (Monad m) = m FileStatus - m System.Posix.Types.EpochTime

where m = IO in this case.

 Also, I like this style:
 import Control.Applicative (($))
 blah = do
   times - mapM (PF.modificationTime $ PF.getFileStatus) filenames
   ...
 The $ operator evaluates to fmap so it's a cleaner way to apply a pure
 function to an IO value.

Usually I'd agree but in fact PF.getFileStatus is not an IO value, but
an IO function, so you need to map over its result:

mapM ((PF.modificationTime $) . PF.getFileStatus) filenames

but then you lose the convenience of the $ as an infix operator, so

mapM (liftM PF.modificationTime . PF.getFileStatus) filenames

is probably clearer in this case. Or, if you're feeling particularly silly:

mapM (fmap fmap fmap modificationTime getFileStatus) filenames
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] mixing map and mapM ?

2010-05-06 Thread Ben Millwood
On Thu, May 6, 2010 at 12:37 PM, Bill Atkins watk...@alum.rpi.edu wrote:
 Just curious: why does getModificationTime take an IO FileStatus rather than
 a FileStatus?


It doesn't. getModificationTime is a pure function (think of it like a
record accessor).

liftM makes it take IO FileStatus because that is what liftM is for :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Location of library documentation with 6.12.1?

2010-05-01 Thread Ben Millwood
On Sat, May 1, 2010 at 1:41 PM, Roly Perera
roly.per...@dynamicaspects.org wrote:
 I can't for example find Control.Monad.State. I guess I'm missing
 something obvious about how things are organised?

The following places might therefore be of interest:

http://hackage.haskell.org/package/mtl
http://hackage.haskell.org/package/monads-tf
http://hackage.haskell.org/package/monads-fd
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Location of library documentation with 6.12.1?

2010-05-01 Thread Ben Millwood
On Sat, May 1, 2010 at 3:33 PM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:
 You need to know which library they're in.

You can use the ghc-pkg tool to do this:

$ ghc-pkg find-module Control.Monad.State
/usr/lib/ghc-6.12.1/package.conf.d
   monads-fd-0.0.0.1
   mtl-1.1.0.2
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Functional Dependencies conflicts

2010-04-17 Thread Ben Millwood
On Sat, Apr 17, 2010 at 9:50 PM, Daniel Fischer
daniel.is.fisc...@web.de wrote:

 {-# LANGUAGE OverlappingInstances, [...]


but with caution:

quicksilver using OverlappingInstances is the haskell equivalent of
buying a new car with high safety rating and replacing the air bags
with poison gas, pouring lubricating oil all over the brake pads,
cutting the cable to the parking brake, and gluing broken glass shards
all over the steering wheel.

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


Re: [Haskell-cafe] Functional Dependencies conflicts

2010-04-17 Thread Ben Millwood
On Sun, Apr 18, 2010 at 12:45 AM, Daniel Fischer
daniel.is.fisc...@web.de wrote:
 Am Sonntag 18 April 2010 01:23:07 schrieb Ben Millwood:
 On Sat, Apr 17, 2010 at 9:50 PM, Daniel Fischer

 daniel.is.fisc...@web.de wrote:
  {-# LANGUAGE OverlappingInstances, [...]

 but with caution:

 quicksilver using OverlappingInstances is the haskell equivalent of
 buying a new car with high safety rating and replacing the air bags
 with poison gas, pouring lubricating oil all over the brake pads,
 cutting the cable to the parking brake, and gluing broken glass shards
 all over the steering wheel.

 :)

 Wow. Makes me wonder what quicksilver says about IncoherentInstances.


Actually, I found that quote while grepping my logs for this one:

@quicksilver undecidable just turns of the termination checker,
which can be find if you're doing something clever outside of the
heuristics of the GHC termination checker.
@quicksilver overlapping actually shatters the language into tiny
inconsistent pieces
@quicksilver and incoherent files off the edges of the pieces so
they don't even fit together any more.

and now I should probably stop using the words of other people
possibly without their knowledge :P
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ghc package problem

2010-04-16 Thread Ben Millwood
On Fri, Apr 16, 2010 at 2:40 PM, Phyx loneti...@gmail.com wrote:
 So same error. This isn't just limited to HSE though, it can't find packages
 like random,time etc either. Keeps reinstalling them on every cabal install.

 C:\Users\Phyx\AppData\Roaming\ghc\i386-mingw32-6.13.20100320\package.conf.d:
    QuickCheck-2.1.0.3
    WinDll-0.1.9
    cpphs-1.11
    ghc-paths-0.1.0.6
    haskell-src-exts-1.9.0
    haskell98-1.0.1.1
    mtl-1.1.0.2
    random-1.0.0.2
    syb-0.1.0.3
    tar-0.3.1.0
    time-1.2.0.1

So every package you are having problems with is in your user package
list? Perhaps there is some disagreement in either Cabal or GHC or
both as to where those packages/that package file should be? Perhaps
try a cabal install --global haskell-src-exts and see if that makes a
difference, or attach --user to a configure command.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] dependent types

2010-04-12 Thread Ben Millwood
On Sun, Apr 11, 2010 at 10:54 PM, Jason Dagit da...@codersbase.com wrote:
 Or, you could use witness types:
 data Vehicle classification = Vehicle { ... }
 mkCar :: Vehicle Car
 mkTruck :: Vehicle Truck
 Then you would export the smart constructors, (mkCar/mkTruck) without
 exporting the Vehicle constructor.
 moveVehicle :: Vehicle c - Simulation ()
 carsOnly :: Vehicle Car - ...
 In the witness type version you may find that defining Vehicle as a GADT is
 even better:
 data Vehicle classification where
   mkCar :: ... - Vehicle Car
   mkTruck :: ... - Vehicle Truck

A minor point of syntax: GADT constructors should begin with a capital letter.
A more important point: GADT constructors are useful for some things
but aren't appropriate for this case because they aren't smart -
they can't take an Int parameter and then make either a Car or a Truck
depending on its value. A smart constructor will need to account for
the possibility that the parameter isn't valid:

mkCar :: Integer - Maybe Vehicle
mkCar weight
 | weight  carWeight = Nothing
 | otherwise = Car { weight = weight }
-- or
mkVehicle :: Integer - Vehicle
mkVehicle weight
 | weight  carWeight = Truck weight
 | otherwise = Car weight

Even with GADTs, you can't pattern match on the constructors unless
you export them, in which case you have to allow for the possibility
that someone might construct an invalid value of the type, so you
might then also need smart field labels that retrieve values from
the Vehicle without allowing you to set them as well (as you would be
able to if you exported the field label itself).

Personally I think this approach is all rather OO. The way that seems
most natural to me is:

moveVehicleAcrossBridge :: Bridge - Vehicle - Maybe Move
moveVehicleAcrossBridge bridge { maxWeight = max } vehicle { weight = w }
 | w  max = Nothing
 | otherwise = {- ... moving stuff ... -}

so you just test the properties directly as and when they are
interesting to you.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell.org re-design

2010-04-06 Thread Ben Millwood
On Wed, Apr 7, 2010 at 2:22 AM, Thomas Schilling
nomin...@googlemail.com wrote:
 I have
 set a maximum width on purpose so that it doesn't degrade too badly on
 big screens.

I've never really trusted this argument - it's not required that the
browser window occupy the entire screen, so why not let the user
choose how wide they want their text?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Where are the haskell elders?

2010-04-05 Thread Ben Millwood
On Mon, Apr 5, 2010 at 3:35 PM, Kim-Ee Yeoh a.biurvo...@asuhan.com wrote:

 Something I've noticed is the phenomenon of Help Vampires [1] on this list.

 Amy Hoy: As soon as an open source project, language, or what-
 have-you achieves a certain notoriety—its half-life, if you will—
 they swarm in, seemingly draining the very life out of the
 community itself.


Hmm. I admire her sentiments in a way - especially not blaming people
for asking bad questions - but I don't like labels or stereotypes and
I don't like condescension, so I would not be happy with this method
being adopted in general.

Especially You're a help vampire which I read as  I'm going to
bundle you with a bunch of other people who annoy me and make you read
a patronising blog post to understand why you've just been compared to
a villainous mythological creature.

But I guess it's preferable to people losing patience entirely, so do
whatever you have to, I suppose.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell.org re-design

2010-04-01 Thread Ben Millwood
On Fri, Apr 2, 2010 at 12:40 AM, Christopher Done
chrisd...@googlemail.com wrote:
 That's true, it's a nice idea but in practice it's hard to know where
 to focus. I've gone with a left nav. I've built up the HTML which is
 cross-browser (ie6/7/8/opera/firefox/safari/chrome compat), still need
 to add some bits but I can tomorrow import it into a wikimedia skin.
 It's kind of easy to re-shuffle now that I've built it.

 http://82.33.137.16/haskell-website/

 Feedback would be appreciated.

There isn't a lot of visual separation between the nav bar and the
main content. I think a border or background colour change might be
nice.
Also, when I let my firefox window fill the screen there's whitespace
on the left and right, when I share my screen with another window the
site doesn't fit horizontally - it doesn't adjust well to changing
window widths.
Also, in the nav bar it should be clearer when an item is linewrapping
and when it is next in the list - on the left it looks like we have
* The Haskell Platform
* Glasgow Haskell
* Compiler
* ...
so, bullet points or adjusted vertical spacing might help there.
Also still quite grey. But I do like the focus on current events - the
first impression you get visiting that page is that Haskell is alive
and well, and people are using and developing it right now. The
pictures of Real People smiling and huddling together really do help
the friendly image we've managed to acquire (and should guard with
utmost vigil, in my opinion).
I think that the About and Learning sections of the original website
are good section titles, and would work well on the navbar. The
easiest thing to do on visiting the website is read about why Haskell
is so great, and where to find out how to use it.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell.org re-design

2010-04-01 Thread Ben Millwood
On Fri, Apr 2, 2010 at 4:36 AM, Ben Millwood hask...@benmachine.co.uk wrote:
 The
 easiest thing to do on visiting the website is read about why Haskell
 is so great, and where to find out how to use it.


Uhm, I meant the easiest thing *should be* reading about...

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


Re: [Haskell-cafe] Re: If wishes were horses...

2010-03-14 Thread Ben Millwood
On Sat, Mar 13, 2010 at 3:19 AM, wren ng thornton w...@freegeek.org wrote:

 The usual approach I've seen is not to distinguish strict and lazy
 datatypes, but rather to distinguish strict and lazy functions, e.g. by
 having two different arrows: (-) for lazy functions and (!-) for strict
 ones.[1]


But what about the laziness properties of e.g. the maybe function?

ghci maybe undefined id (Just ())
()
ghci maybe () undefined Nothing
()
ghci maybe undefined id Nothing
*** Exception: Prelude.undefined
ghci maybe () undefined (Just ())
*** Exception: Prelude.undefined

It's clear that no type signature for maybe is going to tell you about
all these cases. It's similarly impossible to imagine a type signature
that will tell you that take 3 is strict up to the third nested cons
of the input list, and no further. In general, laziness behaviour can
get complicated quickly and so I'm not convinced that the type
signature is a good home for that information.

I suppose a function arrow that had the same effect as putting a !
pattern on the parameter to its left might not be a bad thing
(although we could argue about the exact syntax and representation, as
imo !- is neither intuitively obvious nor aesthetically pleasing),
but it's never going to make seq and ! patterns (which can be applied
on a single equation rather than the whole function, and in
nested/lambda bindings) and so forth redundant.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] cabal install darcs fails on Mac OS X Snow Leopard

2010-03-07 Thread Ben Millwood
On Sun, Mar 7, 2010 at 3:44 PM, George Colpitts
george.colpi...@gmail.com wrote:
 /usr/bin/hsc2hs: line 16: unexpected EOF while looking for matching `'
 /usr/bin/hsc2hs: line 17: syntax error: unexpected end of file

Sounds like a problem with hsc2hs itself.

 When I installed ghc on Snow Leopard I followed the instructions at
 http://www.haskell.org/haskellwiki/Mac_OS_X

It says:
Many packages need hsc2hs. To make it work correctly you need similar hackery:
 * Open /usr/bin/hsc2hs
 * Insert --cflag=-m32 --lflag=-m32 before $tflag

My best guess is that you mistyped this step and dropped a double
quote, or something.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Prelude.undefined

2010-03-03 Thread Ben Millwood
On Wed, Mar 3, 2010 at 6:15 AM, Ivan Miljenovic
ivan.miljeno...@gmail.com wrote:
 On 3 March 2010 16:11, Tom Hawkins tomahawk...@gmail.com wrote:
 -Wall only complains about shadow bindings, defined but not used, and
 no type signature.  But no unmatched patterns.

 Yes it does: one of the options it brings in is
 -fwarn-incomplete-patterns which tells you if you've missed a pattern
 match.

 http://www.haskell.org/ghc/docs/latest/html/users_guide/options-sanity.html


I think he meant that it doesn't because he doesn't have any :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] how to get a string from file

2010-03-03 Thread Ben Millwood
On Wed, Mar 3, 2010 at 6:30 PM, Thomas DuBuisson
thomas.dubuis...@gmail.com wrote:
 On Wed, Mar 3, 2010 at 10:26 AM, Pradeep Wickramanayake prad...@talk.lk 
 wrote:
 getItemFile :: IO String

 This says getItemFile is an action that returns a string.  No arguments.

 getItemFile test = ...

 And your implementation obviously requires a file path as an argument.
  You wanted a type signature of:

 getItemFile :: FilePath - IO String

 or perhaps more simply (FilePath is just an alias for String):

 getItemFile :: String - IO String

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


Or maybe you just want:
getItemFile = do
 test - readFile input.txt
 return test

i.e. exactly what you have but without the argument.
This is actually exactly the same as

getItemFile = readFile input.txt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] How to understand `|` in this code snippet ?

2010-02-27 Thread Ben Millwood
On Sat, Feb 27, 2010 at 9:29 AM, Brandon S. Allbery KF8NH
allb...@ece.cmu.edu wrote:
 On Feb 27, 2010, at 04:07 , zaxis wrote:

 xxxMain = do
   timeout - getEnv xxx_TIMEOUT
   case timeout of
       Just str | [(t, _)] - reads str - do
           addTimeout t (hPutStrLn stderr *** TIMEOUT  _exit 1)
           return ()
       _ - return ()
 ...

 What does the `|` mean in Just str | [(t, _)] - reads str ?
 Is it a logical `or` ?

 It's a guard.  Same as with function definitions (in fact, function
 definitions of that form are converted to case expressions).


In fact it seems to be a pattern guard, which (until recently) are
(were) a non-standard extension:
http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#pattern-guards
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] datakind declaration

2010-02-25 Thread Ben Millwood
On Tue, Feb 23, 2010 at 1:08 AM, Paul Brauner paul.brau...@loria.fr wrote:
 Hello,

 I remember seeing something like

 typedata T = A | B

 somewhere, where A and B are type constructors, but I can't find it in
 the ghc doc. Have I been dreaming or is it some hidden feature ?

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


This is similar to what you are thinking of:

http://hackage.haskell.org/trac/ghc/wiki/KindSystem

...but it's not implemented (yet).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Proper round-trip HughesPJ/Parsec for Doubles?

2010-02-24 Thread Ben Millwood
On Wed, Feb 24, 2010 at 1:24 PM, Christian Maeder
christian.mae...@dfki.de wrote:
 1. break the line after do
 (to avoid a layout change when change name or arguments of float' or
 rename the variable e)

You can also break it immediately before do, which I think is
sometimes more clear.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] STArray newListArray

2010-02-21 Thread Ben Millwood
2010/2/21 Vojtěch Knyttl kny...@gmail.com:
 Hello,

 I am trying to create STArray with newListArray like this:
 la x y = newListArray ((1,1),(x,y)) [(x'+y') | x' - [1..x], y' - [1..y]]

 – but it does not work:
 No instance for (MArray a Field m)

Notice that newListArray has a monadic return type:

newListArray :: (MArray a e m, Ix i) = (i, i) - [e] - m (a i e)

with MArray a e m requiring Monad m.
So newListArray returns your STArray in a monad. That pretty much has
to be the ST monad, but that's not in scope, so you need to import
Control.Monad.ST before the MArray (STArray s) e (ST s) instance is
usable.

 I tried to define the type like this, but it would not work either:
 la :: Int - Int - STArray (Int,Int) Field


The kind for STArray here is slightly off. STArray needs three type
parameters, not two.
This is linked to the fact that ST is not a monad, but (ST s) is - the
extra parameter is essential to ST, to ensure the mutability doesn't
leak out.
You probably want:

la :: Integer - Integer - ST s (STArray s (Integer, Integer) Field)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC RTS question

2010-02-21 Thread Ben Millwood
On Sun, Feb 21, 2010 at 7:10 PM, Max Bolingbroke
batterseapo...@hotmail.com wrote:

 You might be able to get somewhere by writing a custom main function
 in C and linking it in. According to
 http://haskell.org/ghc/docs/latest/html/users_guide/options-phases.html
 if a lib specified with the -l option during compilation contains a
 main, that will be used in preference to the one from HSrts.


I think the neater way of doing this would be to use the FFI, with a
foreign export declaration making your haskell main available to a
wrapper C file, which would then initialise the RTS with a
slightly-modified argc and argv.
See http://www.haskell.org/ghc/docs/latest/html/users_guide/ffi-ghc.html
for details on how to do that.

I also think it's strange, though, that adding RTS hooks is not
optional. GHC should support some method of disabling them, in my
opinion.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] A small oversight

2010-02-20 Thread Ben Millwood
I can't answer your question (about getting minBy into the libraries)
but I thought I'd point out some tricks:

On Sat, Feb 20, 2010 at 10:47 AM, Andrew Coppin
andrewcop...@btinternet.com wrote:
 Also, constructions like

  sortBy (compare `on` foo)

 must surely be very common.

Common enough that Data.Ord introduces comparing:

comparing :: (Ord a) = (b - a) - b - b - Ordering
comparing = (compare `on`)

see 
http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Ord.html#v%3Acomparing
But it would still be useful to have sortOn et al to capture the
common technique when your sorting property is potentially expensive
(sortOn length, for example):

sortOn f = map fst . sortBy (comparing snd) . map (\x - (x, f x))

a technique which I believe is called a Schwarzian transform.

 Finally, take a look at this:

  newtype SwapOrd x = SwapOrd (unswap_ord :: x) deriving Eq

  instance Ord x = Ord (SwapOrd x) where
   compare x y = swap_ord $ compare x y

  swap_ord :: Ordering - Ordering
  swap_ord o = case o of
   EQ - EQ
   GT - LT
   LT - GT

 Just in case you wanted to sort things in reverse order. I think having
 swap_ord would be nice if nothing else...


swap_ord (compare x y) = compare y x, so usually flip compare fills
this requirement :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Implementing unionAll

2010-02-18 Thread Ben Millwood
On Thu, Feb 18, 2010 at 8:07 AM, Evan Laforge qdun...@gmail.com wrote:
 And BTW again, here's something I've occasionally found useful:

 -- | Handy to merge or sort a descending list.
 reverse_compare :: (Ord a) = a - a - Ordering
 reverse_compare a b = case compare a b of
    LT - GT
    EQ - EQ
    GT - LT

I wondered why there wasn't one of these in the standard library until
someone pointed out to me that

reverse_compare = flip compare

which actually takes fewer characters to type :P
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Two GET HTTP requests

2010-02-07 Thread Ben Millwood
On Fri, Feb 5, 2010 at 5:51 PM, Chris Eidhof ch...@eidhof.nl wrote:
 Approach 2: I installed the 'download-curl' package, and tried again. This 
 seems to fail on the following example:

 import Network.Curl.Download

 main = do x - openURI http://haskell.org;
           y - openURI http://haskell.org/hoogle;
           return ()

 If I put a print statement around the second line of the do-statement it 
 looks like openURI never returns.


I think you're supposed to use withCurlDo:
http://hackage.haskell.org/packages/archive/curl/latest/doc/html/Network-Curl.html#v%3AwithCurlDo
with the curl library. Could be wrong about that, haven't tried it myself.

 Approach 3: I used the simpleHTTP function from the HTTP package. This 
 crashed, after I dug a little deeper into the code, it threw an error on 
 calling the parseURI function (openFile: no such file exists). I installed 
 the latest network package and upgraded my HTTP package, and the parseURI 
 error went away. I felt like I was almost there, and tried the following:

 simpleHTTP (getRequest http://haskell.org;)

 This failed with just the text Bus error. I searched the HTTPBis git 
 repository, but couldn't find the text Bus error. I don't have a clue of 
 how to fix this.

Bus error is a message generated by the operating system. On OS X,
it can mean a null dereference, which is very unusual. I'm not sure
how you'd debug it either - the most common cause when you're talking
about C applications is programmer error, but Network.HTTP is
specifically designed to be pure Haskell, and it's not easy to induce
a null dereference from Haskell.

 I'm a bit stuck here, I would love to help fix the errors, but don't know 
 what would be the best place to begin. If anyone can point me in the right 
 direction, I will try to patch at least one of these packages.

I don't think anyone would blame you if you didn't manage it, none of
those are particularly friendly errors.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Multi-Class monadic type?

2010-02-03 Thread Ben Millwood
On Wed, Feb 3, 2010 at 1:10 PM, Alexander Treptow
alexander.trep...@googlemail.com wrote:
 testFunc :: (forall a. Conf a, MonadIO m = m a) - TestType

At a guess, this function takes a tuple containing a forall a. Conf a
and a MonadIO m = m a, which is not what you meant. As Miguel says,
more parentheses are the answer.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Allowing hyphens in identifiers

2009-12-16 Thread Ben Millwood
On Wed, Dec 16, 2009 at 2:55 PM, Daniel Fischer
daniel.is.fisc...@web.de wrote:
 unCamel :: String - String
 unCamel ('':cs) = '' : inTag cs
 unCamel (a:b:c:cs)
    | isLower a  isUpper b  isLower c = a : '_' : toLower b : c : unCamel 
 cs
 unCamel (a:bs@(b:cs))
    | isLower a  isUpper b    = a : '_' : b : unCamel cs
    | otherwise                 = a : unCamel bs
 unCamel cs = cs

Excuse my pedantry, but: writeToList - write_toList.
I think the third equation needs to be:

 unCamel (a:b:cs@(c:_))
  | isLower a  isUpper b  isLower c = a : '_' : toLower b : unCamel cs

so that the third character is not ignored in subsequent parses.

By the way, I like camelCase because I think that in most cases you
*don't* want to break identifiers up into their component words - you
read and understand what the function does once, and then you use it
as a word in its own right. Any resemblance to actual English is
really just a mnemonic of sorts.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Parallel foldl doesn't work correctly

2009-12-12 Thread Ben Millwood
On Sat, Dec 12, 2009 at 10:08 AM, Maciej Piechotka
uzytkown...@gmail.com wrote:
 If operation is associative it can be done using divide et impera
 spliting list in half and operating on it pararerlly then split in half
 etc.

I implemented something like this as an exercise:

http://benmachine.co.uk/parconcat.hs

It took me a little while to get everything to par as it should and
I'm still not sure I'm doing it in the most efficient way, but there
it is.

(If the output is nonsense, you might try changing hPutStrLn stderr
into putStrLn so that it's buffered and arrives in blocks).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Status of TypeDirectedNameResolution proposal?

2009-11-24 Thread Ben Millwood
On Sun, Nov 22, 2009 at 7:13 PM, Ketil Malde ke...@malde.org wrote:

 E.g. if module Foo.Bar isn't found in Foo/Bar.hs GHC could look in
 Foo.hs (which would just contain a concatenation of what would currently
 reside in Foo.hs and Foo/Bar.hs).

The obvious question arising here is what if module Foo.Bar *is* found
in Foo/Bar.hs as well as in Foo.hs - is the latter ignored? It doesn't
sound like an insurmountable problem but one of the nicest things
about the current module system is its simplicity and predictability,
both of which are somewhat attacked by this proposal.
Also, it sounds like your proposal would disallow definition of
multiple top-level modules in a file, because we wouldn't know where
to look for them. This is not necessarily unreasonable, but it's an
unexpected special case.
Presumably having the modules together in a file would also mean that
they could only be compiled together and would produce a single .o or
.hi file. Then you might ask whether the ABI or whatever is
necessarily broken by a change to *any* of the modules involved, in
which case modularisation starts to become purely about name
qualification. Thinking about that, it's worth noting that importing
one module twice with two different names works fine.
This is not to say I'm against the proposal, but it's probably not as
clear-cut as it sounds.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Where is `newTVarIO` defined ?

2009-11-24 Thread Ben Millwood
On Tue, Nov 24, 2009 at 11:11 PM, zaxis z_a...@163.com wrote:

 I cannot hoogle it. It appears in Pugs:

 run' (-d:rest)                 = do
    info - fmap Just (io $ newTVarIO Map.empty)
    let ?debugInfo = info
    run' rest

 Sincerely!

 -
 fac n = foldr (*) 1 [1..n]
 --
 View this message in context: 
 http://old.nabble.com/Where-is-%60newTVarIO%60-defined---tp26504967p26504967.html
 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


http://hackage.haskell.org/packages/archive/stm/latest/doc/html/Control-Concurrent-STM-TVar.html
The docs for it are in GHC.Conc but you probably wouldn't import it from there.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: Re[Haskell-cafe] cursive to foldr

2009-11-18 Thread Ben Millwood
It looks quite neat to use the Maybe monoid here:

 import Data.Monoid
 searchList p = foldr (\x - if p x then mappend (Just [x]) else id) Nothing

but it seems that the Maybe Monoid instance keeps this strict. I
fiddled with this a bit, and came up with the following:

 instance (Monoid m) = Monoid (Maybe m) where
  mempty = Nothing -- as usual
  mappend (Just x) y = Just $ mappend x (fromMaybe mempty y)
  mappend Nothing y = y

which results in the expected behaviour (it's unsatisfyingly
asymmetric, since it should (but can't) produce a Just if the second
argument is Just without pattern-matching on the first, but there is
only so much one can do without involving scary things like unamb).

I'd be interested in what people thought of the relative merits of
this alternative Monoid instance, but perhaps that would be a subject
for a different thread.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Help Haskell driving Medical Instruments

2009-11-11 Thread Ben Millwood
On Tue, Nov 10, 2009 at 5:04 AM, Philippos Apolinarius
phi50...@yahoo.ca wrote:

  foreign import ccall rs232.h opencport opencport :: CInt - IO ()
  foreign import ccall rs232.h closecport closecport :: CInt - CInt

[...]

 Originally, I had the following line (that did not work properly):

 foreign import ccall rs232.h closecport closecport ::  IO ()


I don't know why the latter line didn't work properly, but I'm pretty
sure it's closer to the right answer than the former. If you don't
have an IO type for your function, then Haskell is allowed to assume
it is pure (has no side effects) and can then call it only when the
result is needed, or multiple times if it likes, without affecting the
meaning of the program. For a function that closes a handle this is
clearly not the case.
So I'm pretty sure your type signature needs to be in IO if you want
to guarantee it is called at the right time; it might be worth
elaborating on how the IO () version did not work, and how you used
it.
The way you are using it now would appear to work most of the time
because the print statement will force the result to be evaluated,
forcing the function to be called - but having a handle closed based
on when an apparently irrelevant print statement runs or doesn't is
obviously not ideal.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Medical Instruments - Jason

2009-11-11 Thread Ben Millwood
On Wed, Nov 11, 2009 at 6:00 PM, Philippos Apolinarius
phi50...@yahoo.ca wrote:

  closecport :: Int - IO Int
  closecport n= return (fromIntegral (c_closecport (fromIntegral n)))


The return here doesn't do what you think it does - semantically, the
value of c_closecport is still considered pure and assumed to be
referentially transparent, so multiple calls to closecport are allowed
to share the value returned, or delay the call until the value is
unwrapped, call it multiple times for each use of the value, or
anything else. You need to use IO *directly* in the foreign import
declaration so that the compiler knows that the function calls can't
be shared or inlined or generally messed about with: the IO tells it
that order of execution with respect to your other IO actions is
important.
This one looks the most right:
foreign import stdcall unsafe rs232.h closecport closecport :: IO ()
so I think you need to look closer about why it wasn't working for
you, and where or how you were using it.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Interactive chatbot

2009-11-04 Thread Ben Millwood
Oops, I clicked reply instead of reply to all. Duplicating the
message below.
I suppose this means someone is going to get two copies of this. Sorry someone!

On Thu, Nov 5, 2009 at 12:56 AM, Ben Millwood hask...@benmachine.co.uk wrote:
 On Wed, Nov 4, 2009 at 10:21 PM, Torsten Otto t-otto-n...@gmx.de wrote:

 When we read the user's input through
   t - getLine
 it is not possible to delete typos before hitting enter and thereby sending
 the input off to the system (at least in OS X, bash). I didn't find that
 terribly problematic, but of course it is a bit of a show stopper from their
 point of view.


 As people have said it's worth checking what buffering settings you
 are using (especially note that ghci changes some interesting settings
 in relation to how input is handled, and compiled code may behave
 differently), but it might also be worth checking the terminal
 application's preferences to see if there are settings related to the
 interpretation of the backspace key that you need to twiddle one way
 or the other. In particular, if you are finding that pressing delete
 makes ^H appear on the input line instead of deleting things, or if
 pressing ctrl-H deletes stuff where the delete key fails to do so, it
 might be a problem with your terminal rather than with your program.
 This is only based on what I vaguely remember from faffing with the
 Mac Terminal application some time ago when it wouldn't co-operate
 with screen, but it may be worth a look.

 yours,
 Ben Millwood

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