[Haskell-cafe] how to force hackage to use ghc 6.12.3

2011-05-08 Thread Michal Konečný
Hi,

I have been releasing packages on hackage that do not build with ghc 7.0.* due 
to  a bug that will be fixed in ghc 7.2.1.   (One of the packages is 
http://hackage.haskell.org/package/AERN-Basics)
I was hoping hackage will try also ghc 6.12.3 but it does not.  Is there some 
way I can change the cabal file to help hackage to compile it with 6.12.3 and 
generate haddock?  The package requires base >= 4 so I cannot try base < 4.

Michal
-- 
|-| Dr. Michal Konecny, Computer Science, Aston University 
|-| Room MB212D | Tel +44 121 204 3462 | Fax +44 121 204 3681
|-| http://www.aston.ac.uk/~konecnym
|-| OpenPGP key http://www.aston.ac.uk/~konecnym/ki.aston

-- 
|o| Michal Konecny 
|o|http://www-users.aston.ac.uk/~konecnym/
|o|office: (+42) (0)121 204 3462 
|o| PGP key http://www-users.aston.ac.uk/~konecnym/ki.aston


signature.asc
Description: This is a digitally signed message part.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ANN: Newt - command-line template instantiation tool & library

2011-05-08 Thread briand
On Sun, 8 May 2011 16:23:59 -0700
Rogan Creswick  wrote:

> Newt scans the input (either a file, directory or stdin) for tags
> marked with "<<>>" [1], then replaces those entries with
> values specified on the command line, producing either a new file,
> modifying the input template in place (--inplace), writing to stdout,
> or writing to a directory.

This is a useful tool !

I would like to suggest allowing customization of the syntax to indicate a tag, 
e.g. {# #} instead of <<< >>> (You just knew someone was going to say that, 
right ? :-)

I only mention this in the hopes that it still early enough for you to write 
the code in such a way to allow this even if you don't implement it right away.


Brian

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


[Haskell-cafe] repa Shape help

2011-05-08 Thread briand
Howdy,

as usual, the haskell type system complete defeats me in the simplest of 
applications:

import Data.Array.Repa as A
import Data.Array.Repa.Index
import Data.Array.Repa.Shape as AS

main = do
  let x = A.fromList (AS.shapeOfList [2, 2]) ([1.0, 2.0, 3.0, 4.0]::[Double])
  putStrLn $ show x

test_repa.hs:10:13:
Ambiguous type variable `sh' in the constraint:
  `Shape sh' arising from a use of `show' at test_repa.hs:10:13-18
Probable fix: add a type signature that fixes these type variable(s)
Failed, modules loaded: none.

After much staring at the type signatures I finally figured out that adding a 
type annotation to x of :

  :: Array DIM2 Double

would fix the problem, but I'm not completely clear as to why.

after all fromList is typed:

(Shape sh, Elt a) => sh -> [a] -> Array sh a

Since it knows [a] is [Double] and sh must be - well I'm not really clear on 
what sh is supposed to be.  therein lies my problem.  Although it does seem 
that sh can be darn near anything, which is probably why it was ambiguous.

At one point I had tried something like (2 :. 2) and got a whole host of errors 
for that too, except that DIM2 is defined in exactly that way, so it's not at 
all obvious why that didn't work.

I was hoping someone could clarify on what's going on.


Thanks,

Brian


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


Re: [Haskell-cafe] ANNOUNCE: iterIO-0.1 - iteratee-based IO with pipe operators

2011-05-08 Thread Richard O'Keefe

On 7/05/2011, at 2:44 PM, Mario Blažević wrote:
> As I said, the most usual name for the Enumerator concept would be Generator.
> That term is already used in several languages to signify this kind of
> restricted coroutine. I'm not aware of any good alternative naming for 
> Iteratee.

This being Haskell, I'm expecting to see Cogenerator (:-) (:-).


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


[Haskell-cafe] ANN: Newt - command-line template instantiation tool & library

2011-05-08 Thread Rogan Creswick
I'm happy to announce Newt: a trivial tool for creating boilerplate.

I frequently need to create projects with slight customizations -- I
have a particular layout for cabal projects, and make files for LaTeX
papers, etc...  However, there are often fields that need to be
updated in many places.  (At times, even file or directory names need
changed.)  Newt makes this trivial.  My objective was to provide a
tool that allows you to very quickly take a project, mark the portions
that must change with angle brackets, and use that as a source for
myriad derivations of that project, or share the project for others to
create their own instances.

Newt scans the input (either a file, directory or stdin) for tags
marked with "<<>>" [1], then replaces those entries with
values specified on the command line, producing either a new file,
modifying the input template in place (--inplace), writing to stdout,
or writing to a directory.

A newt template for a cabal project is available on github:
  - 
http://github.com/creswick/Newt/tree/master/tests/testFiles/dirTemplates/cabalProject

Newt is available on hackage[2], and the source is hosted on github[3].

The readme provides more details and examples:
 - http://github.com/creswick/Newt/blob/master/README.md

--Rogan

[1] The tag syntax can be changed with command-line flags, or by
creating an instance of the Tag typeclass.  See --help.
[2] http://hackage.haskell.org/package/newt
[3] http://github.com/creswick/Newt/

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


Re: [Haskell-cafe] For Project Euler #24 you don't need to generate all the lexicographic permutations

2011-05-08 Thread KC
I see from the solutions on Project Euler others did think of this way
but at least on my last IQ test I did get an 'A'; 95.

I am a jenius. :D


-- 
--
Regards,
KC

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


Re: [Haskell-cafe] trying to cabal install lambdabot, failure on 'random' package

2011-05-08 Thread Albert Y. C. Lai

On 11-05-08 03:24 AM, Sean Perry wrote:

package random-1.0.0.3 requires time-1.2.0.3
package random-1.0.0.3 requires time-1.2.0.4


In addition to unregistering --user random-1.0.0.3, also unregister 
--user time-1.2.0.4, the real culprit. The real culprit is why you are 
infected with a duplicate random-1.0.0.3. If you let time-1.2.0.4 live, 
the problem will just recur infinitely.


See my
http://www.vex.net/~trebla/haskell/sicp.xhtml
for why this happens and what it costs you. And never "upgrade" packages 
piecemeal like this again.


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


[Haskell-cafe] Apache license, any drawbacks for Haskell packages?

2011-05-08 Thread Magnus Therning
Are there any drawbacks to using the Apache license for Haskell
packages?

/M

-- 
Magnus Therning  OpenPGP: 0xAB4DFBA4 
email: mag...@therning.org   jabber: mag...@therning.org
twitter: magthe   http://therning.org/magnus

I invented the term Object-Oriented, and I can tell you I did not have
C++ in mind.
 -- Alan Kay


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


Re: [Haskell-cafe] For Project Euler #24 you don't need to generate all the lexicographic permutations

2011-05-08 Thread Jeff Wheeler
On Sun, May 8, 2011 at 10:41 AM,   wrote:
> For Project Euler #24 you don't need to generate all the lexicographic
> permutations by Knuth's method or any other.

This is a clever, smart solution. You should post it to the Haskell
Wiki page [0].

[0] http://haskell.org/haskellwiki/Euler_problems/21_to_30


-- 
Jeff Wheeler

Undergraduate, Electrical Engineering
University of Illinois at Urbana-Champaign

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


[Haskell-cafe] For Project Euler #24 you don't need to generate all the lexicographic permutations

2011-05-08 Thread caseyh
For Project Euler #24 you don't need to generate all the lexicographic  
permutations by Knuth's method or any other.


You're only looking for the millionth lexicographic permutation of  
"0123456789"



Problem 24

A permutation is an ordered arrangement of objects. For example, 3124  
is one possible permutation of the digits 1, 2, 3 and 4. If all of the  
permutations are listed numerically or alphabetically, we call it  
lexicographic order. The lexicographic permutations of 0, 1 and 2 are:


012   021   102   120   201   210

What is the millionth lexicographic permutation of the digits 0, 1, 2,  
3, 4, 5, 6, 7, 8 and 9?



























Plan of attack:

-- The "x"s are different numbers
-- 0x represents 9! = 362880 permutations/numbers
-- 1x represents 9! = 362880 permutations/numbers
-- 2x represents 9! = 362880 permutations/numbers


-- 20 represents 8! = 40320
-- 21 represents 8! = 40320

-- 23 represents 8! = 40320
-- 24 represents 8! = 40320
-- 25 represents 8! = 40320
-- 26 represents 8! = 40320
-- 27 represents 8! = 40320

etc.






















-- lexOrder "0123456789" 100 ""

lexOrder digits left s
| len == 0  = s ++ digits
| quot > 0 && rem == 0  = lexOrder (digits\\(show  
(digits!!(quot-1  rem (s ++ [(digits!!(quot-1))])
| quot == 0 && rem == 0 = lexOrder (digits\\(show (digits!!len)))  
  rem (s ++ [(digits!!len)])
| rem == 0  = lexOrder (digits\\(show  
(digits!!(quot+1  rem (s ++ [(digits!!(quot+1))])
| otherwise = lexOrder (digits\\(show  
(digits!!(quotrem (s ++ [(digits!!(quot))])

where
len = (length digits) - 1
facLen = factorial len
(quot,rem) = quotRem left facLen




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


Re: [Haskell-cafe] Type-class conditional behavior

2011-05-08 Thread dm-list-haskell-cafe
At Sat, 7 May 2011 22:14:27 -0700,
Nicholas Tung wrote:
> 
> Dear all,
> 
>     I'd like to write a function "maybeShow :: a -> Maybe String", which runs
> "show" if its argument is of class Show.

You can't do this, because in general there is no way to know whether
an arbitrary object a is of class Show.  In fact, in the worst case,
you could even have two different instances of Show for the same type
defined in two different modules of your program.  Obviously you can't
import both modules with both instances into the same module, but what
if you didn't import either--how would the compiler know where to find
the Show function or which one to use.

The best you could hope for is to run show if type a is *known* to be
in class Show at your call site.  But that would lead to some pretty
weird behavior.  For instance, the following two functions would be
different--f1 would always return Just, and f2 would always return
Nothing, which is why I assume no combination of LANGUAGE pragmas
would allow it:

f1 :: (Show a) => a -> Maybe String
f1 = maybeShow

f2 :: a -> Maybe String
f2 = maybeShow

In fact, I suspect that your arrow example is more like f2, in that
you don't have a Show dictionary around, so maybeShow will always
return nothing.

Is there any way you can pass the function around explicitly, as in:

data AV t where
  AVLeft :: AV (a, a -> Maybe String)
 -> AV (Either (a, a -> Maybe String) b)

It is also possible to pass dictionaries around explicitly using the
ExistentialQuantification extension (which is required by the standard
library exception mechanism, so is probably a reasonably safe one to
rely on).  Can you do something like the following?

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}

data Showable a = forall a. (Show a) => Showable a

data AV t where
  AVLeft :: AV (Showable a) -> AV (Either (Showable a) b)

David

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


Re: [Haskell-cafe] trying to cabal install lambdabot, failure on 'random' package

2011-05-08 Thread Daniel Fischer
On Sunday 08 May 2011 09:24:50, Sean Perry wrote:
> package random-1.0.0.3 requires time-1.2.0.3
> package random-1.0.0.3 requires time-1.2.0.4
> Preprocessing library show-0.4.1.1...
> Building show-0.4.1.1...
> : cannot satisfy -package-id
> random-1.0.0.3-749b78c54a8a1b32dbb45d98a91b: 
> random-1.0.0.3-749b78c54a8a1b32dbb45d98a91b is shadowed by package
> random-1.0.0.3-57524486875e0c4c260dd22788921013

You have two versions(?) of random-1.0.0.3, one in the global package-db, 
one in the user-db. The one in the user-db shadows the global, making it 
unusable. That's BAD. Having boot packages (random, process, directory, 
time, ...) in both, global and user db, tends to break stuff, check what's 
broken already with

$ ghc-pkg check

If too much is broken, delete your user-db and reinstall fresh, otherwise 
try unregistering the ones in the user-db shadowing stuff in the global db, 
in particular random-1.0.0.3,

$ ghc-pkg unregister --user random-1.0.0.3

It will probably notify you that unregistering that will break a couple of 
other packages, the best would probably be to unregister those too and 
rebuild them against the global random.

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


Re: [Haskell-cafe] trying to cabal install lambdabot, failure on 'random' package

2011-05-08 Thread Stephen Tetley
It looks like cabal-install is wanting to do wacky things to the GHC
boot libraries, which means something is seriously astray.

What happens when you run `ghc-pkg check` ?

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


Re: [Haskell-cafe] no time profiling on my MacBookPro8,1

2011-05-08 Thread Malcolm Wallace

On 6 May 2011, at 23:07, Nicolas Frisby wrote:

> all of the %time cells in the generated Main.prof file are 0.0, as is
> the total time count (0.00 secs and 0 ticks). The %alloc cells seem
> normal.

See
http://hackage.haskell.org/trac/ghc/ticket/5137

Regards,
Malcolm


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


Re: [Haskell-cafe] Type-class conditional behavior

2011-05-08 Thread Gábor Lehel
On Sun, May 8, 2011 at 7:14 AM, Nicholas Tung  wrote:
> Dear all,
>     I'd like to write a function "maybeShow :: a -> Maybe String", which
> runs "show" if its argument is of class Show.
>     The context and motivation for this are as follows. I have a GADT type
> which encapsulates abstract-value computation (or constants or error codes),
> a snippet of which is below.
> data AV t where
>     AVLeft :: AV a -> AV (Either a b)
>     This is used to implement an arrow transformer, and due to Arrows
> mapping all Haskell functions, I cannot put some kind of qualification on
> the constructor, like "AVLeft :: Show a => ...".
>     Of course any replies are welcome, but I do need something implemented
> and stable. If there are GHC-compatible hacks, even an "unsafeShow :: a ->
> String", that'd be great. I'd also prefer not to branch on all types which
> could possibly be maybeShow's argument.

To the best of my knowledge, this is impossible. Haskell/GHC lets you
require that certain type-level (predicates/assertions/constraints be
true? evidence/proof be supplied? I'm not sure what the correct
terminology is), but it doesn't let you branch over *whether* it is
so. A natural solution would be OverlappingInstances, but that doesn't
help in this case: instances are matched only by the instance head,
and the context is checked only afterwards. So if you have

class MaybeShow a where maybeShow :: a -> Maybe String
instance MaybeShow a where maybeShow = const Nothing
instance Show a => MaybeShow a where maybeShow = Just . show

you have two instances which both match for any 'a', resulting in
overlap any time you try to use it, and rendering this 'solution'
unworkable. There's a section on advanced overlap in the wiki[1], but
it's Really Ugly and doesn't (to my mind) actually solve the problem
(you still have to branch on every potential type).

You could do:

class MaybeShow a where maybeShow :: a -> Maybe String
instance MaybeShow a where maybeShow = const Nothing
newtype Showable a = Showable { getShowable :: a }
instance Show a => MaybeShow (Showable a) where maybeShow = Just .
show . getShowable

which lets you write further MaybeShow instances for specific types to
'forward' the Show instance (which isn't any worse than the
AdvancedOverlap solution, if you have to handle every type explicitly
anyways), and you can also write maybeShow (Showable x) at the use
site if you know that x has a Show instance. But at that point you
might as well perform some 'optimization' and just use show directly,
so this doesn't really get you anywhere.

[1] http://www.haskell.org/haskellwiki/GHC/AdvancedOverlap



>
>
>     (Concretely, if I have "newtype AVFunctor a b c = AVF (a (AV b) (AV
> c))", then the Arrow class declaration forces all types, c.f. variable b, to
> be potential variables of type AV),
> class (Category a) => Arrow a where
>   arr :: (b -> c) -> a b c
>
> Thanks very much,
> Nicholas — https://ntung.com — CS major @ UC Berkeley
>
> p.s. I posted this question on StackOverflow if you care to get brownie
> points there, http://goo.gl/PrmYW
> p.s. 2 -- if there is a general "dump var" function in ghci, which does more
> than ":info", I'd love to know :)
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>



-- 
Work is punishment for failing to procrastinate effectively.

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


Re: [Haskell-cafe] trying to cabal install lambdabot, failure on 'random' package

2011-05-08 Thread Sean Perry

On May 7, 2011, at 12:41 AM, Stephen Tetley wrote:

> "show" is the failing package
> 
> A look on Hackage suggests that "show" had problems with its cabal
> file at versions 0.4 & 0.4.1 and was fixed at 0.4.1.1.
> 
> Can you try installing "show" individually at 0.4.1.1 the try
> installing the rest of lambdabot.
> 

$ cabal install show
Resolving dependencies...
Configuring show-0.4.1.1...
Warning: This package indirectly depends on multiple versions of the same
package. This is highly likely to cause a compile failure.
package haskell98-1.1.0.1 requires random-1.0.0.3
package QuickCheck-2.4.0.1 requires random-1.0.0.3
package show-0.4.1.1 requires random-1.0.0.3
package random-1.0.0.3 requires time-1.2.0.3
package random-1.0.0.3 requires time-1.2.0.4
Preprocessing library show-0.4.1.1...
Building show-0.4.1.1...
: cannot satisfy -package-id 
random-1.0.0.3-749b78c54a8a1b32dbb45d98a91b: 
random-1.0.0.3-749b78c54a8a1b32dbb45d98a91b is shadowed by package 
random-1.0.0.3-57524486875e0c4c260dd22788921013
(use -v for more information)
cabal: Error: some packages failed to install:
show-0.4.1.1 failed during the building phase. The exception was:
ExitFailure 1


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


Re: [Haskell-cafe] Type-class conditional behavior

2011-05-08 Thread Ryan Ingram
The behavior you are asking for "maybeShow" violates parametricity, so it
can't exist without some sort of typeclass constraint.

That said, in your particular situation, it's an interesting question.

The Show instance for Either is

instance (Show a, Show b) => Show (Either a b) where ...

so we as programmers know that, given some instance Show (Either a b) that
there must be an instance for a.  But we can't get at it!

Inside the compiler, this instance looks something like this:

data ShowDict a = ShowDict {
 showsPrec :: Int -> a -> String -> String,
 show :: a -> String,
 shows :: a -> String -> String,
 showsList :: [a] -> String -> String
   }

showEither :: (ShowDict a, ShowDict b) -> ShowDict (Either a b)
showEither (sda, sdb) = ShowDict ...

Note that inside the functions returned by showEither we've "lost" the
parent dictionaries sda/sdb.

However we know the behavior of these functions, and you can hack around it
with a manual show instance that takes advantage of that knowledge:

instance Show t => Show (AV t) where
show (AVLeft a) = drop 5 $ show (Left a)

The 'drop 5' takes off the 'Left ' in the returned string.  To be a bit
smarter you'd also look for surrounding parens and remove them as well, but
this is how you could solve your problem.

All this said, I agree that the presence of 'arr' in Arrow is a problem for
many types of generalized computing.  It overly constrains what can be an
arrow, in my opinion.  I think a better analysis of the primitives required
for arrow notation to work would solve a lot of problems of this type.

  -- ryan

On Sat, May 7, 2011 at 10:14 PM, Nicholas Tung  wrote:

> Dear all,
>
> I'd like to write a function "maybeShow :: a -> Maybe String", which
> runs "show" if its argument is of class Show.
>
> The context and motivation for this are as follows. I have a GADT type
> which encapsulates abstract-value computation (or constants or error codes),
> a snippet of which is below.
>
> data AV t where
> AVLeft :: AV a -> AV (Either a b)
>
> This is used to implement an arrow transformer, and due to Arrows
> mapping all Haskell functions, I cannot put some kind of qualification on
> the constructor, like "AVLeft :: Show a => ...".
>
> Of course any replies are welcome, but I do need something implemented
> and stable. If there are GHC-compatible hacks, even an "unsafeShow :: a ->
> String", that'd be great. I'd also prefer not to branch on all types which
> could possibly be maybeShow's argument.
>
>
>
> (Concretely, if I have "newtype AVFunctor a b c = AVF (a (AV b) (AV
> c))", then the Arrow class declaration forces all types, c.f. variable b, to
> be potential variables of type AV),
>
> class (Category a) => Arrow a where
>   arr :: (b -> c) -> a b c
>
>
> Thanks very much,
> Nicholas — https://ntung.com — CS major @ UC Berkeley
>
> p.s. I posted this question on StackOverflow if you care to get brownie
> points there, http://goo.gl/PrmYW
>
> p.s. 2 -- if there is a general "dump var" function in ghci, which does
> more than ":info", I'd love to know :)
>
> ___
> 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] Type-class conditional behavior

2011-05-08 Thread Stephen Tetley
On 8 May 2011 06:14, Nicholas Tung  wrote:
> Dear all,
>     I'd like to write a function "maybeShow :: a -> Maybe String", which
> runs "show" if its argument is of class Show.

I'm pretty sure this is not readily possible - there might be some
hack through Typeable but that would oblige but Show and Typeable
constraints on the type of "a".



>     The context and motivation for this are as follows. I have a GADT type
> which encapsulates abstract-value computation (or constants or error codes),
> a snippet of which is below.
> data AV t where
>     AVLeft :: AV a -> AV (Either a b)
>     This is used to implement an arrow transformer, and due to Arrows
> mapping all Haskell functions, I cannot put some kind of qualification on
> the constructor, like "AVLeft :: Show a => ...".

Yes you can, from the GHC docs:

http://haskell.org/ghc/docs/7.0-latest/html/users_guide/data-type-extensions.html#gadt

  data Showable where
MkShowable :: Show a => a -> Showable

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