[Haskell-cafe] [Alternative] summary of my understanding so far

2011-12-15 Thread Gregory Crosswhite
Hey everyone!

First of all, it sounds like we all agree that the documentation for 
Alternative needs to be improved;  that alone would clear a lot of the 
confusion up.

I think that a fairly convincing case has also been made that removing 
many/some from the typeclass doesn't help too much since they are generically 
defined in terms of the other methods.  Put another way, arguing that removing 
many/some makes Alternative more safe would be like arguing that removing 
forever from the definition of Monad (assuming it were currently a method 
rather than a function) made Monad more safe.  (On the other hand, it might be 
nice if many/some were not featured so prominently above other 
functions/combinators in the module.)

As a corollary to the above paragraph, if the many/some methods *were* moved to 
a subclass --- call it, Parser --- then essentially this subclass would be 
redundant.  Nonetheless, such a subclass could still be useful because it 
supplies more information to the user about how the type behaves.  That is, 
while any user of an instance of Alternative can always theoretically use 
something like many/some, in practice a user might want to add the Parser 
constraint to their type just to get an extra guarantee that many/some not only 
exist but are well-behaved.

Although many/some cause infinite loops for the current instance of Maybe and 
[], forever also causes loops for (return (undefined)) for any Monad.  Thus, 
even in the likely event that we decide to keep many/some in Alternative, it 
still makes sense to have Alternative instances for Maybe and [], despite the 
fact that they don't play well with many/some for non-empty values.

In fact, if anything the existence of the Maybe and [] instances provides a 
strong reason *to* have the many/some methods inside Alternative, precisely 
because it gives us a customization point that allows us to make many and some 
provide well-defined answers for all values of these types.  To quote Ross 
Paterson's proposals:

instance Alternative Maybe where
   ...
   some Nothing = Nothing
   some (Just x) = Just (repeat x)

   many Nothing = Just []
   many (Just x) = Just (repeat x)

instance Alternative [] where
   ...
   some [] = []
   some (x:xs) = repeat (repeat x)

   many [] = [[]]
   many (x:xs) = repeat (repeat x)

The only price that we pay for these instances is that, while some and many are 
still solutions of

• some v = (:) $ v * many v
• many v = some v | pure []

they no longer the *least* solutions of these equations.  In my opinion this is 
a relatively small price to pay since they nonetheless *are* solutions to these 
questions, and they have the nice property that they converge sensibly.  In 
fact, in a sense they are the least solutions to the equations that out of all 
the solutions that converge, though I don't know enough about the theory 
involved to use the proper technical terminology to express what I really mean, 
or even if what I just wrote was true.  :-)

Anyway, as the above discussion illustrates, the existence of pure types that 
are instances of Alternative actually *adds* to the case of keeping some and 
maybe in Alternative.

So in conclusion:

1) Documentation really needs to be improved
2) some/many cannot be physically separated from Alternative, but there *might* 
be an advantage to creating a subclass for them anyway purely for the sake of 
conveying more information about a type to users
3) Maybe and [] are sensible instances of Alternative, even if many/some often 
enters an infinite loop.
4) It is possible to provide special instance of many/some that satisfy the 
equations of many/some, with the slight disadvantage that these solutions are 
no longer the least solutions.

Based on all of this, at this moment in time it seems to me that the most 
sensible way forward is to fix the documentation, tweak the definition of 
Alternative to no longer require the least solutions of the equations, and then 
to adopt the new instances for Maybe and [].

Thoughts?

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


Re: [Haskell-cafe] [Alternative] change some/many semantics

2011-12-15 Thread Gregory Crosswhite

On Dec 15, 2011, at 5:40 PM, Antoine Latter wrote:

 I said 'combinators', not 'instances'.

Oh!  Okay, that was my bad then.

 A lot of popular parsers
 combinators can be written exclusively from (|) and empty, but make
 little sense for List and Maybe, and may not even function properly.
 The 'trifecta' package includes a nice reference:
 
 http://hackage.haskell.org/packages/archive/trifecta/0.49.1/doc/html/Text-Trifecta-Parser-Combinators.html
 
 See 'skipSome' through 'chainr1' - I wouldn't be surprised if most of
 these lead to the same infinite loop behavior for Maybe as the stock
 'many' and 'some' in base.
 
 These sorts of functions are what Alternative is for.

Okay, I see better now what you mean.  Thank you.

But then, if so much code based on Alternative makes little sense for List and 
Maybe, then maybe this should be a signal they we should remove their instance 
from Alternative?  After all, we already have the Monad typeclass which gives 
them essentially the same functionality.

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


Re: [Haskell-cafe] [Alternative] change some/many semantics

2011-12-15 Thread Gregory Crosswhite

On Dec 15, 2011, at 6:19 PM, Gregory Crosswhite wrote:

 After all, we already have the Monad typeclass which gives them essentially 
 the same functionality.

Make that the *Monoid* typeclass.  :-)

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


[Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Gregory Crosswhite
Hey everyone,

First, thank you all for this great discussion!  I unfortunately have been home 
due to health concerns which gets really boring after a while, so being able to 
participate in such a fun intellectual exercise like has really been making my 
day.  :-D  Sorry that this has resulted in such a flood of commentary on the 
list!

Antoine Latter has pointed out to me that (using my own words here) essentially 
entire parser libraries are built around the assumption that many and some are 
sensibly defined the way that they are, and that as a result much of their 
functionality simply doesn't make sense for Maybe and [].

So maybe the best approach to take really is to remove the instance for Maybe 
and [] from Alternative.  After all, some and many simply are not well-behaved 
for them, and if you are using Alternative you are expecting them to be 
well-behaved.

Now, on the other hand, one might argue:  but Maybe and [] have well-defined 
functions for empty and |, so since some and many are defined in terms of 
these operations, shouldn't that make Maybe and [] natural instances of 
Alternative anyway?

And *this* is where Haskell separates its way from other languages.  In others 
language we may very well just say, Well, good point, why not make them 
instances of Alternative, and simply not worry about the fact that some and 
many don't behave well --- just don't use them like that!

But in Haskell we don't do things this way.  When we make something be an 
instance of a typeclass, we want that to *mean* something.  In the case of 
Alternative, we want, among other things, for it to mean that our type has 
sensible meanings for some and many --- and if Maybe and [] simply do not meet 
this criteria, then THEN THEY DESERVE TO BE CAST OUT!

I know, I know, I can hear you all shouting:  This is blasphemy! This is 
madness! 

Madness?  This... IS HASKELL!

But on a more serious note, it turns out that we *already* have a typeclass 
that does everything that Alternative does but without the some and many 
baggage:  it's called Monoid!  So we can already get all of the features that 
we need (and most likely have been using anyway) by using the Monoid instances 
for Maybe and [] and just forgetting about the existence of Alternative 
entirely.

So at the end of the day... what is the point of even making Maybe and [] 
instances of Alternative?

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


Re: [Haskell-cafe] [Alternative] change some/many semantics

2011-12-15 Thread Antoine Latter
On Thu, Dec 15, 2011 at 2:20 AM, Gregory Crosswhite
gcrosswh...@gmail.com wrote:

 On Dec 15, 2011, at 6:19 PM, Gregory Crosswhite wrote:

 After all, we already have the Monad typeclass which gives them essentially
 the same functionality.


 Make that the *Monoid* typeclass.  :-)

And this is an interesting discussion all of its own!

Should the monoid instance of a Functor do what List does - which is
analogious to its append or choice operation (where applicable), or
should it do what Maybe does, which is lift the operation into its
contained type? (That is, (Just x) `mappend` (Just y) == Just (x
`mappend` y)).

Since the Monoid instance for Maybe doesn't offer choice between
Nothing and Some, it would be nice to have a standard choice operation
that we could use for Maybe.

Which is sort of what Alternative is - offering choice over a functor
which supports it. Except that the notion of what choice means is
richer in a parser than in Maybe (parsers may backtrack (like List)
and parsing has some sort of stateful effect, which affects the
success of future parses).

It is an interesting dilemma.

I am also fond of using Alternative (disguised as MonadPlus) in the
Happstack sense, for building a web-site routing table. In the truest
sense I am composing alternative responses to an input request, but
using 'many', 'some', or 'sepEndBy` in this context would be odd.

Antoine

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


Re: [Haskell-cafe] Typechecking Using GHC API

2011-12-15 Thread Niklas Broberg
Currently: Your only option is to use GHC API if you want type checking. I
can't help you with that, sorry.

Envisioned: The function you ask for can definitely be written for
haskell-src-exts, which I know you are currently using. I just need to
complete my type checker for haskell-src-exts first. Which is not a small
task, but one that has been started. I doubt it will be done in time for
your project though, sorry.

Best regards,

/Niklas

On Tue, Dec 13, 2011 at 6:16 PM, Sh NJP shayan@gmail.com wrote:

 Hi,

 I do some pre-processing on a normal Haskell code ( -F ). The
 pre-processor needs to know the type of each expression.
 What are the possibilities to do so?
 Can I use GHC API to employ GHC type checker? If yes, any good tutorial?
 Is it too naive to think of a function, f :: String - AnnotatedAST , that
 takes Haskell code and returns its corresponding abstract syntax tree
 annotated with types?

 Thanks,
  /shayan

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


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


Re: [Haskell-cafe] [Alternative] change some/many semantics

2011-12-15 Thread malcolm.wallace
On 15 Dec, 2011,at 03:58 AM, Gregory Crosswhite gcrosswhite@gmailcom wrote:This is even more out there than my previous posts, but the following just occurred to me: is it absolutely necessary that some/many have produced the entire list of results before returning?No, it is not absolutely necessary. Couldn't we change their semantics so that the list of results is computed and/or extracted lazily?I do not regard that as a change in their semantics - it is perfectly allowed already Indeed, the instances of some/many that I write are already lazily-unfolding, wherever possible. It all depends simply on whether your instance of Applicative is lazy or strict.Regards, Malcolm___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typechecking Using GHC API

2011-12-15 Thread JP Moresmau
My own buildwrapper package (available from github and hackage) uses
both haskell-src-exts and the GHC API to provide the same kind of
services to the EclipseFP IDE plugins. You may be able to use it
directly for your purpose or at least have a look at the code to get a
feel for how to use the GHC API.

Hope this helps

JP

On Thu, Dec 15, 2011 at 11:07 AM, Niklas Broberg
niklas.brob...@gmail.com wrote:
 Currently: Your only option is to use GHC API if you want type checking. I
 can't help you with that, sorry.

 Envisioned: The function you ask for can definitely be written for
 haskell-src-exts, which I know you are currently using. I just need to
 complete my type checker for haskell-src-exts first. Which is not a small
 task, but one that has been started. I doubt it will be done in time for
 your project though, sorry.

 Best regards,

 /Niklas

 On Tue, Dec 13, 2011 at 6:16 PM, Sh NJP shayan@gmail.com wrote:

 Hi,

 I do some pre-processing on a normal Haskell code ( -F ). The
 pre-processor needs to know the type of each expression.
 What are the possibilities to do so?
 Can I use GHC API to employ GHC type checker? If yes, any good tutorial?
 Is it too naive to think of a function, f :: String - AnnotatedAST , that
 takes Haskell code and returns its corresponding abstract syntax tree
 annotated with types?

 Thanks,
  /shayan

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



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




-- 
JP Moresmau
http://jpmoresmau.blogspot.com/

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


Re: [Haskell-cafe] [Alternative] change some/many semantics

2011-12-15 Thread Gregory Crosswhite

On Dec 15, 2011, at 9:31 PM, malcolm.wallace wrote:

 I do not regard that as a change in their semantics - it is perfectly allowed 
 already  Indeed, the instances of some/many that I write are already 
 lazily-unfolding, wherever possible.  It all depends simply on whether your 
 instance of Applicative is lazy or strict.

That makes sense.  So the problem is not with Alternative but with Maybe:  
specifically, the problem is that there is no way to write a fully lazy 
instance of Applicative for Maybe since both arguments have to be reduced to 
WHNF before we can determine the WHNF of the result of applying ($), and this 
is why some/many cannot return lazily generated lists of results.

Put another way, the problem with Maybe computations is that if there is a 
failure at any point in the computation than *the entire computation fails*, 
and this means that you can't lazily generate a list of results using some/many 
because you can't tell whether your computation was a success or a failure 
until the entire infinite computation has been run;  the only solution to this 
problem is, as others have suggested, to build domain-specific knowledge about 
Maybe into the some/many methods of Alternative instance, which I think is one 
of the good solutions that has been brought up in this discussion.  :-)

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


Re: [Haskell-cafe] How to get a file path to the program invoked?

2011-12-15 Thread Peter Wortmann

Hi

I was running into a similar problem while working on GHC not long ago -
short version is that it's not even possible to find out the executable
path portably from C [1]. Using argv[0] just gave me the path of the GHC
wrapper script, for example - as it uses exec without -a.

The whole thing is easiest if you're on Linux:

  getExePath = readSymbolicLink /proc/self/exe

On all other operation system, one needs to start mucking around with
custom kernel calls.

Or, more realistically, try to find a way around requiring it...

Greetings,
  Peter Wortmann

[1] http://stackoverflow.com/questions/1023306




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


Re: [Haskell-cafe] [Alternative] some/many narrative

2011-12-15 Thread Brent Yorgey
On Thu, Dec 15, 2011 at 07:29:20PM +1300, Chris Wong wrote:
  Okay, so how about the following as a user narrative for some and many?
 
  ...
 
 I was in the middle of writing my own version of Applicative when I
 stumbled on this intense debate. Here's what I wrote for the
 documentation:
 
 class (Applicative f, Monoid f) = Alternative f where

Note that 'Monoid f' does not make sense, since the kinds do not
match. Perhaps what you mean is  (forall a. Monoid (f a)) but that is
(currently) impossible to express.  One could, of course, make a new
typeclass

  class Monoid1 f where
mempty1 :: f a
mappend1 :: f a - f a - f a

-Brent

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Brent Yorgey
On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:
 
 So at the end of the day... what is the point of even making Maybe and [] 
 instances of Alternative?

The Alternative and Monoid instances for [] are equivalent.  However,
the Alternative and Monoid instances for Maybe are not. To wit:

   (Just (Sum  4)) | (Just (Sum 3))
  Just (Sum {getSum = 4})

   (Just (Sum 4)) `mappend` (Just (Sum 3))
  Just (Sum {getSum = 7})

-Brent

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Anthony Cowley
On Dec 15, 2011, at 10:19 AM, Brent Yorgey wrote:

 On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:
 
 So at the end of the day... what is the point of even making Maybe and [] 
 instances of Alternative?
 
 The Alternative and Monoid instances for [] are equivalent.  However,
 the Alternative and Monoid instances for Maybe are not. To wit:
 
 (Just (Sum  4)) | (Just (Sum 3))
  Just (Sum {getSum = 4})
 
 (Just (Sum 4)) `mappend` (Just (Sum 3))
  Just (Sum {getSum = 7})

We already have,

 First (Just (Sum 4)) `mappend` First (Just (Sum 3))
First {getFirst = Just (Sum {getSum = 4})}

So the overlap of apparent Alternative and Monoid functionality remains. This 
just represents an opportunity for the caller to select the monoid they want.

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Yves Parès
So why don't we use First and Last with the Alternative interface too?

It's indeed weird the Maybe doesn't react the same way with Alternative and
Monoid.

2011/12/15 Anthony Cowley acow...@gmail.com

 On Dec 15, 2011, at 10:19 AM, Brent Yorgey wrote:

  On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:
 
  So at the end of the day... what is the point of even making Maybe and
 [] instances of Alternative?
 
  The Alternative and Monoid instances for [] are equivalent.  However,
  the Alternative and Monoid instances for Maybe are not. To wit:
 
  (Just (Sum  4)) | (Just (Sum 3))
   Just (Sum {getSum = 4})
 
  (Just (Sum 4)) `mappend` (Just (Sum 3))
   Just (Sum {getSum = 7})

 We already have,

  First (Just (Sum 4)) `mappend` First (Just (Sum 3))
 First {getFirst = Just (Sum {getSum = 4})}

 So the overlap of apparent Alternative and Monoid functionality remains.
 This just represents an opportunity for the caller to select the monoid
 they want.

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

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


[Haskell-cafe] Type checker for haskell-src-exts (was: Typechecking Using GHC API)

2011-12-15 Thread Sean Leather
On Thu, Dec 15, 2011 at 11:07, Niklas Broberg wrote:

 Envisioned: The function you ask for can definitely be written for
 haskell-src-exts, which I know you are currently using. I just need to
 complete my type checker for haskell-src-exts first. Which is not a small
 task, but one that has been started.


That's good to know! I presume it's something like Haskell98 to start with?
I'd be even more impressed (and possibly also concerned for your health) if
you were going to tackle all of the extensions!

I've been trying to find a student to write a haskell-src-exts type checker
for me. It should use a particular kind of mechanism though, using
constraints similar to [1]. Then, I want to adapt that to do
transformations. What approach are you using? Maybe I can somehow steal
your work... ;)

Regards,
Sean

[1] http://www.staff.science.uu.nl/~heere112/phdthesis/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] [Alternative] some/many narrative

2011-12-15 Thread Thomas Schilling
On 15 December 2011 06:29, Chris Wong chrisyco+haskell-c...@gmail.com wrote:

 class (Applicative f, Monoid f) = Alternative f where
    -- | Keep repeating the action (consuming its values) until it
 fails, and then return the values consumed.

I think this should be collect rather than consume and you can
omit the parentheses.  I also think that we should include the
original definition, which is more formally precise (although it could
use with some examples).

    --
    -- [Warning]: This is only defined for actions that eventually fail

Perhaps add the remark that we expect non-deterministic actions.

    -- after being performed repeatedly, such as parsing. For pure values such
    -- as 'Maybe', this will cause an infinite loop.
    some :: f a - f [a]
    some v = ...

    -- | Similar to 'many', but if no values are consumed it returns
 'empty' instead of @f []@.
    --
    -- [Warning]: This is only defined for actions that eventually fail
    -- after being performed repeatedly, such as parsing. For pure values such
    -- as 'Maybe', this will cause an infinite loop.
    many :: f a - f [a]
    many v = ...

 Warnings are repeated for emphasis :)

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



-- 
Push the envelope. Watch it bend.

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


Re: [Haskell-cafe] Type checker for haskell-src-exts (was: Typechecking Using GHC API)

2011-12-15 Thread Thomas Schilling
What exactly are the hopes for such a type checker?  I can understand
it being interesting as a research project, but as a realistic tools
there are two huge issues:

 1. It's going to take a LOT of time to reach feature parity with
GHC's type checker.

 2. Assuming that can be done, how is it going to be maintained and
kept up to date with GHC?

If it is going to be used as a development tool, both of these are a
major requirement.  I haven't looked into the issues, but I'd expect
it would be more realistic (although definitely not trivial) to
translate from GHC's internal AST into an annotated haskell-src-exts
AST.

On 15 December 2011 16:33, Sean Leather leat...@cs.uu.nl wrote:
 On Thu, Dec 15, 2011 at 11:07, Niklas Broberg wrote:

 Envisioned: The function you ask for can definitely be written for
 haskell-src-exts, which I know you are currently using. I just need to
 complete my type checker for haskell-src-exts first. Which is not a small
 task, but one that has been started.


 That's good to know! I presume it's something like Haskell98 to start with?
 I'd be even more impressed (and possibly also concerned for your health) if
 you were going to tackle all of the extensions!

 I've been trying to find a student to write a haskell-src-exts type checker
 for me. It should use a particular kind of mechanism though, using
 constraints similar to [1]. Then, I want to adapt that to do
 transformations. What approach are you using? Maybe I can somehow steal your
 work... ;)

 Regards,
 Sean

 [1] http://www.staff.science.uu.nl/~heere112/phdthesis/

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




-- 
Push the envelope. Watch it bend.

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


Re: [Haskell-cafe] How to get a file path to the program invoked?

2011-12-15 Thread Thomas Schilling
May I ask what the problem is you're trying to solve?

If you want to access datafiles in an installed program then Cabal can
help you with that.  See
http://www.haskell.org/cabal/users-guide/#accessing-data-files-from-package-code

If you want to do more complicated things, maybe take a look at how
GHC does it.  For example, on OS X (and other Unix-based systems) the
ghc command is actually a script:

$ cat `which ghc`
#!/bin/sh
exedir=/Library/Frameworks/GHC.framework/Versions/7.0.3-x86_64/usr/lib/ghc-7.0.3
exeprog=ghc-stage2
executablename=$exedir/$exeprog
datadir=/Library/Frameworks/GHC.framework/Versions/7.0.3-x86_64/usr/share
bindir=/Library/Frameworks/GHC.framework/Versions/7.0.3-x86_64/usr/bin
topdir=/Library/Frameworks/GHC.framework/Versions/7.0.3-x86_64/usr/lib/ghc-7.0.3
pgmgcc=/Developer/usr/bin/gcc
executablename=$exedir/ghc
exec $executablename -B$topdir -pgmc $pgmgcc -pgma $pgmgcc
-pgml $pgmgcc -pgmP $pgmgcc -E -undef -traditional ${1+$@}

/ Thomas

On 1 December 2011 16:12, dokondr doko...@gmail.com wrote:
 Hi,
 When my program starts it needs to know a complete path to the directory
 from which it was invoked.
 In terms of standard shell (sh) I need the Haskell function that will do
 equivalent to:

 #!/bin/sh
 path=$(dirname $0)

 How to get this path in Haskell?

 getProgName :: IO String
 defined System.Environment only returns a file name of the program without
 its full path.

 Thanks!

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




-- 
Push the envelope. Watch it bend.

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


Re: [Haskell-cafe] [Alternative] some/many narrative

2011-12-15 Thread Bryan O'Sullivan
On Wed, Dec 14, 2011 at 10:29 PM, Chris Wong 
chrisyco+haskell-c...@gmail.com wrote:

-- [Warning]: This is only defined for actions that eventually fail
-- after being performed repeatedly, such as parsing. For pure values
 such
-- as 'Maybe', this will cause an infinite loop.


This is both confusing and incorrect. It's entirely possible for an action
in the Maybe type to fail.

For the Maybe type, failing means an action returns Nothing, and
succeeding means an action returns Just (some value).

If an action of type Maybe a is written to always and unconditionally
return Just some-value-or-other, *that's* when some or many will
infinite-loop if used with it. That doesn't mean there's something wrong
with the definitions of some or many, but rather that they need to be
supplied with an action that will at some point fail.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Carl Howells
Monoid and Alternative are not the same.  There is a very important
difference between them:

class Alternative f where
(|) :: f a - f a - f a
...

class Monoid a where
mappend :: a - a - a
...

The equivalent to Alternative is MonadPlus, not Monoid.  The kinds
matter.  In Alternative, you are guaranteed that the type that f is
applied to cannot affect the semantics of (|).  As has been already
demonstrated aptly, the type a in the instance Monoid a = Monoid
(Maybe a) matters quite a lot.

Carl

On Thu, Dec 15, 2011 at 8:04 AM, Yves Parès limestr...@gmail.com wrote:
 So why don't we use First and Last with the Alternative interface too?

 It's indeed weird the Maybe doesn't react the same way with Alternative and
 Monoid.


 2011/12/15 Anthony Cowley acow...@gmail.com

 On Dec 15, 2011, at 10:19 AM, Brent Yorgey wrote:

  On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:
 
  So at the end of the day... what is the point of even making Maybe and
  [] instances of Alternative?
 
  The Alternative and Monoid instances for [] are equivalent.  However,
  the Alternative and Monoid instances for Maybe are not. To wit:
 
  (Just (Sum  4)) | (Just (Sum 3))
   Just (Sum {getSum = 4})
 
  (Just (Sum 4)) `mappend` (Just (Sum 3))
   Just (Sum {getSum = 7})

 We already have,

  First (Just (Sum 4)) `mappend` First (Just (Sum 3))
 First {getFirst = Just (Sum {getSum = 4})}

 So the overlap of apparent Alternative and Monoid functionality remains.
 This just represents an opportunity for the caller to select the monoid they
 want.

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



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


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


[Haskell-cafe] smt solver bindings

2011-12-15 Thread Dimitrios Vytiniotis

I've a quick question:

Are there Haskell wrappers for the Z3 C API around?

Thanks!
d-



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


Re: [Haskell-cafe] indentation blues

2011-12-15 Thread Ivan S. Freitas
For vim, there is a indent script, I don't remember exactly where I
found it but it's on my github repo:
https://github.com/ISF/dotfiles/blob/master/.vim/indent/haskell.vim

(And don't forget the haskellmode for vim)

Also, I've used the haskell mode of emacs with vimpulse to emulate vim
motions. It is pretty good, indentation works out-of-the-box (except
that you can't use indent-region), and the inferior handling works
well. I still prefer vim to use with haskell, specially when editing
my xmonad configuration.

-- 
Ivan Sichmann Freitas
GNU/Linux user #509059

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


Re: [Haskell-cafe] smt solver bindings

2011-12-15 Thread Daniel Peebles
Not that I know of, but I would like them too. There are a few bindings to
yices, but I don't think yices has the feature I want in it.

On Thu, Dec 15, 2011 at 1:04 PM, Dimitrios Vytiniotis 
dimit...@microsoft.com wrote:


 I've a quick question:

 Are there Haskell wrappers for the Z3 C API around?

 Thanks!
 d-



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

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


Re: [Haskell-cafe] smt solver bindings

2011-12-15 Thread Josef Svenningsson
On Thu, Dec 15, 2011 at 7:04 PM, Dimitrios Vytiniotis 
dimit...@microsoft.com wrote:


 I've a quick question:

 Are there Haskell wrappers for the Z3 C API around?

 I believe sbv recently got support for Z3 but I don't know if it uses the
C API. Neither have I tried the Z3 backend, I only played with the Yices
backend. If you contact Levent Erkök, the author of sbv, he should be able
to give you more information.

 https://github.com/LeventErkok/sbv

Thanks,

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Conor McBride


On 15 Dec 2011, at 15:19, Brent Yorgey wrote:


On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:


So at the end of the day... what is the point of even making Maybe  
and [] instances of Alternative?


The Alternative and Monoid instances for [] are equivalent.  However,
the Alternative and Monoid instances for Maybe are not. To wit:


(Just (Sum  4)) | (Just (Sum 3))

 Just (Sum {getSum = 4})


(Just (Sum 4)) `mappend` (Just (Sum 3))

 Just (Sum {getSum = 7})


The current monoid instance for Maybe is, in my view, unfortunate.

Types are about semantic purpose, not just data representation.
Many purposes can be represented in the same way. We should identify
the purpose of a type (or type constructor), then define instances
consistent with that purpose. And better, we acquire by instance
inference compound instances consistent with that purpose! (A similar
view is often articulated well by Conal Elliott. But perhaps it's
just a Con thing.)

The purpose of Maybe, it seems to me, is to model failure and
prioritized choice, after the manner of exceptions. It's clear
what the failure-and-prioritized-choice monoid is.

It so happens that the same data representation can be used to make
a semigroup into a monoid by attaching an identity element. That's
a different semantic purpose, which deserves a different type.

This really bites. I really like being able to write things like

  newtype P a x = P ([a] - Maybe (x, [a])) deriving Monoid

and then make MonadPlus/Alternative instances just by copying the
monoid that results, but it doesn't work!

It's unfortunate that we don't have local quantification in
constraints, so we can't write (forall x. Monoid (f x)), hence the
need for constructor classes doing basically the same job, with,
of necessity, newly renamed members. I think it compounds the
problem to choose inconsistent behaviour between the constructor
class and the underlying type class.

Maybe I'm an extremist, but I'd prefer it if every Alternative
instance was constructed by duplicating a polymorphic Monoid
instance.

Meanwhile, as for the issue which kicked this off, I do think it's
good to document and enforce meaningful (i.e. total on total input)
usages of operations by types where practical. At present, refining
one type class into several to account for subtle issues (like
whether some/many actually work) is expensive, even if it's
desirable. I'd once again plug default superclass instances and
Control.Newtype, then suggest that the library might benefit from a
little pruning.

All the best

Conor

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


Re: [Haskell-cafe] ANNOUNCE: hxournal-0.5.0.0 - A pen notetaking program written in haskell

2011-12-15 Thread Edward Z. Yang
When I attempt to build on Ubuntu, I get:

ezyang@javelin:~$ cabal install hxournal
Resolving dependencies...
Configuring hxournal-0.5.0.0...
Preprocessing library hxournal-0.5.0.0...
In file included from /usr/include/gtk-2.0/gdk/gdkscreen.h:32:0,
 from /usr/include/gtk-2.0/gdk/gdkapplaunchcontext.h:31,
 from /usr/include/gtk-2.0/gdk/gdk.h:32,
 from /usr/include/gtk-2.0/gtk/gtk.h:32,
 from Device.hsc:3:
/usr/include/gtk-2.0/gdk/gdktypes.h:55:23: fatal error: gdkconfig.h: No such 
file or directory
compilation terminated.
compiling dist/build/Application/HXournal/Device_hsc_make.c failed (exit code 1)
command was: /usr/bin/gcc -c dist/build/Application/HXournal/Device_hsc_make.c 
-o dist/build/Application/HXournal/Device_hsc_make.o -fno-stack-protector 
-fno-stack-protector 
-Wl,--hash-style=both,--no-copy-dt-needed-entries,--as-needed 
-D__GLASGOW_HASKELL__=700 -Dlinux_BUILD_OS -Dlinux_HOST_OS -Di386_BUILD_ARCH 
-Di386_HOST_ARCH -Icsrc -I/usr/include/glib-2.0 
-I/usr/lib/i386-linux-gnu/glib-2.0/include -I/usr/include/atk-1.0 
-I/usr/include/cairo -I/usr/include/gdk-pixbuf-2.0 -I/usr/include/pango-1.0 
-I/usr/include/gio-unix-2.0/ -I/usr/include/pixman-1 -I/usr/include/freetype2 
-I/usr/include/libpng12 -I/usr/include/libdrm -I/usr/include/gtk-2.0 
-I/usr/lib/gtk-2.0/include -I/usr/include/pango-1.0 -I/usr/include/glib-2.0 
-I/usr/lib/i386-linux-gnu/glib-2.0/include -I/usr/include/cairo 
-I/usr/include/pixman-1 -I/usr/include/freetype2 -I/usr/include/libpng12 
-I/usr/include/glib-2.0 -I/usr/lib/i386-linux-gnu/glib-2.0/include 
-I/usr/include/glib-2.0 -I/usr/lib/i386-linux-gnu/glib-2.0/include 
-I/usr/include/cairo -I/usr/include/glib-2.0 
-I/usr/lib/i386-linux-gnu/glib-2.0/include -I/usr/include/pixman-1 
-I/usr/include/freetype2 -I/usr/include/libpng12 
-I/usr/lib/ghc-7.0.3/process-1.0.1.5/include 
-I/usr/lib/ghc-7.0.3/directory-1.1.0.0/include 
-I/usr/lib/ghc-7.0.3/old-time-1.0.0.6/include 
-I/usr/lib/ghc-7.0.3/unix-2.4.2.0/include 
-I/usr/lib/ghc-7.0.3/time-1.2.0.3/include 
-I/usr/lib/ghc-7.0.3/bytestring-0.9.1.10/include 
-I/usr/lib/ghc-7.0.3/base-4.3.1.0/include -I/usr/lib/ghc-7.0.3/include 
-I/usr/lib/ghc-7.0.3/include/
cabal: Error: some packages failed to install:
hxournal-0.5.0.0 failed during the building phase. The exception was:
ExitFailure 1

This may be of interest:

ezyang@javelin:~$ locate gdkconfig.h
/home/ezyang/Dev/gtk+/gdk/gdkconfig.h.win32
/usr/include/gtk-3.0/gdk/gdkconfig.h
/usr/lib/i386-linux-gnu/gtk-2.0/include/gdkconfig.h

Edward

Excerpts from Edward Z. Yang's message of Mon Dec 12 20:10:19 -0500 2011:
 Very fancy! I am a big fan of Xournal, so I will have to take this for a spin.
 
 Edward
 
 Excerpts from Ian-Woo Kim's message of Mon Dec 12 06:56:09 -0500 2011:
  Hi, everyone,
  
  I am very pleased to announce a pen notetaking program: hxournal,
  which is written entirely in haskell using gtk2hs.
  
  I uploaded the package on hackage. This program accompanies with
  two library packages, xournal-parser and xournal-render for parsing
  and rendering xournal format file.
  
  http://hackage.haskell.org/package/hxournal
  http://hackage.haskell.org/package/xournal-parser
  http://hackage.haskell.org/package/xournal-render
  
  Installing hxournal should be very simple:
   cabal update
   cabal install hxournal
  
  hxournal can be currently regarded as a clone of xournal, which is a
  notetaking program developed in C. (See
  http://xournal.sourceforge.net)
  
  As xournal, hxournal can take wacom tablet X11 input in subpixel unit
  so that it can result in very smooth notetaking experience.
  
  Currently, basic pen operations and eraser operations, file open/save
  operations, rectangular selection, cut/copy/paste operations have been
  implemented. So the application is semi-usable. The file format is
  the same as xournal but gunzipped. So to view/edit xoj files generated
  from xournal, just gunzip the xoj files and read them in hxournal.
  Gunzipped xoj files generated from hxournal are readable in xournal
  program.
  
  One NEW special feature of hxournal compared with xournal:
  This program can make a split view (horizontal and vertical and
  arbitrary combination of them) of the same document similarly to emacs
  buffers and windows. Please try Horizontal/Vertical Split in View menu
  of the program. This will be convenient when notetaking a long
  document.
  
  The git repository is located at https://www.github.com/wavewave/hxournal
  The program web page and development web/wiki pages will be announced
  soon (it will be linked from package webpage on hackage anyway) and
  the detailed manual will be presented there.
  
  Thank you for your interest.
  Enjoy haskell notetaking!
  
  Ian-Woo Kim
  

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


Re: [Haskell-cafe] How to get a file path to the program invoked?

2011-12-15 Thread Brandon Allbery
On Thu, Dec 15, 2011 at 09:48, Peter Wortmann sc...@leeds.ac.uk wrote:

 path portably from C [1]. Using argv[0] just gave me the path of the GHC
 wrapper script, for example - as it uses exec without -a.


Note that exec -a is a bash-ism and not portable to POSIX shells (ash on
*BSD, dash on Debian/Ubuntu, etc.) or traditional /bin/sh as still shipped
with some commercial Unixes.

-- 
brandon s allbery  allber...@gmail.com
wandering unix systems administrator (available) (412) 475-9364 vm/sms
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] [Alternative] summary of my understanding so far

2011-12-15 Thread Chris Wong
On Thu, Dec 15, 2011 at 9:13 PM, Gregory Crosswhite
gcrosswh...@gmail.com wrote:
 First of all, it sounds like we all agree that the documentation for
 Alternative needs to be improved;  that alone would clear a lot of the
 confusion up.

I wonder if fully documenting the Haskell base library is a valid
SoC project :)

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


Re: [Haskell-cafe] [Alternative] some/many narrative

2011-12-15 Thread Gregory Crosswhite

On Dec 16, 2011, at 3:34 AM, Bryan O'Sullivan wrote:

 This is both confusing and incorrect. It's entirely possible for an action in 
 the Maybe type to fail.

Okay, so inserting the phrases that either fail eventually or and that 
succeed forever if they do not immediately fail so that that the documentation 
reads:

   -- [Warning]: This is only defined for actions that either fail immediately 
or that eventually fail
   -- after being performed repeatedly, such as parsing. For pure values such
   -- as 'Maybe' that succeed forever if they do not immediately fail, this 
will cause an infinite loop.

makes the situation more clear.

Cheers,
Greg

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Gregory Crosswhite

On Dec 16, 2011, at 3:59 AM, Carl Howells wrote:

 Monoid and Alternative are not the same.  There is a very important
 difference between them:
 
 class Alternative f where
(|) :: f a - f a - f a
...
 
 class Monoid a where
mappend :: a - a - a
...
 
 The equivalent to Alternative is MonadPlus, not Monoid.  The kinds
 matter.  In Alternative, you are guaranteed that the type that f is
 applied to cannot affect the semantics of (|).

I understand that one needs to worry about kinds in general, but in this 
particular case such a subtlety is non-issue because you would always be 
defining Monad for a particular type.  That is to say, given an alternative f, 
the instance of Monoid would be

instance Monoid (f a) where { ... }

where in the above a is an arbitrary type variable.

To give you a more concrete example, the following code compiles and runs, 
producing the output [1,2,3,4,5,6]



import Data.Monoid

newtype L a = L [a] deriving (Show,Eq)

instance Monoid (L a) where
   mempty = L []
   mappend (L x) (L y) = L (x ++ y)

main = putStrLn . show $ (L [1,2,3]) `mappend` (L [4,5,6])



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


Re: [Haskell-cafe] How to get a file path to the program invoked?

2011-12-15 Thread Richard O'Keefe

On 16/12/2011, at 11:55 AM, Brandon Allbery wrote:
 
 Note that exec -a is a bash-ism and not portable to POSIX shells

Recent versions of ksh also support this, so it's not just bash.
But there are certainly a lot of POSIX shells that don't, including
the version of ksh on my main machine.


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


Re: [Haskell-cafe] [Alternative] some/many narrative

2011-12-15 Thread Brent Yorgey
On Thu, Dec 15, 2011 at 09:34:14AM -0800, Bryan O'Sullivan wrote:
 On Wed, Dec 14, 2011 at 10:29 PM, Chris Wong 
 chrisyco+haskell-c...@gmail.com wrote:
 
 -- [Warning]: This is only defined for actions that eventually fail
 -- after being performed repeatedly, such as parsing. For pure values
  such
 -- as 'Maybe', this will cause an infinite loop.
 
 
 If an action of type Maybe a is written to always and unconditionally
 return Just some-value-or-other, *that's* when some or many will

The way you phrased this sounds odd to me.  Every action/value of type
Maybe a will *either* always and unconditionally be Nothing, OR
always and unconditionally be Just some-value-or-other.  By
referential transparency, those are the only options.

-Brent

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-15 Thread Brent Yorgey
On Thu, Dec 15, 2011 at 09:05:13PM +, Conor McBride wrote:
 
 On 15 Dec 2011, at 15:19, Brent Yorgey wrote:
 
 On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:
 
 So at the end of the day... what is the point of even making
 Maybe and [] instances of Alternative?
 
 The Alternative and Monoid instances for [] are equivalent.  However,
 the Alternative and Monoid instances for Maybe are not. To wit:
 
 (Just (Sum  4)) | (Just (Sum 3))
  Just (Sum {getSum = 4})
 
 (Just (Sum 4)) `mappend` (Just (Sum 3))
  Just (Sum {getSum = 7})
 
 The current monoid instance for Maybe is, in my view, unfortunate.
 
 Types are about semantic purpose, not just data representation.
 Many purposes can be represented in the same way. We should identify
 the purpose of a type (or type constructor), then define instances
 consistent with that purpose. And better, we acquire by instance
 inference compound instances consistent with that purpose! (A similar
 view is often articulated well by Conal Elliott. But perhaps it's
 just a Con thing.)
 
 The purpose of Maybe, it seems to me, is to model failure and
 prioritized choice, after the manner of exceptions. It's clear
 what the failure-and-prioritized-choice monoid is.
 
 It so happens that the same data representation can be used to make
 a semigroup into a monoid by attaching an identity element. That's
 a different semantic purpose, which deserves a different type.

I agree.  Moreover, the current Monoid instance for (Maybe a) does not
even achieve this, since it requires a *Monoid* instance on a, rather
than a semigroup.  

Note that the 'semigroups' package defines an 'Option' type which does
lift Semigroup instances to Monoid instances.  I, for one, would be
quite in favor of changing the current Monoid (Maybe a) instance to
correspond to the failure-and-prioritized-choice semantics (i.e. the
semantics currently given to the 'First' wrapper).

-Brent

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