[Haskell-cafe] runST readSTRef type error

2011-05-04 Thread Ken Takusagawa II
I run into the following type error:

foo :: ST s (STRef s Int) - Int
foo p = (runST (p = readSTRef))

with ghc 6.12.1
st.hs:8:16:
Couldn't match expected type `s1' against inferred type `s'
  `s1' is a rigid type variable bound by
   the polymorphic type `forall s1. ST s1 a' at st.hs:8:9
  `s' is a rigid type variable bound by
  the type signature for `foo' at st.hs:7:10
  Expected type: ST s1 (STRef s Int)
  Inferred type: ST s (STRef s Int)
In the first argument of `(=)', namely `p'
In the first argument of `runST', namely `(p = readSTRef)'

However, if I add
{-# LANGUAGE RankNTypes #-}

and change the type signature to
foo :: (forall s.ST s (STRef s Int)) - Int

it works.  I don't fully understand what's going on here.

Is this the right way to fix the problem?  Are there other options?
My gut feeling is, for such a simple use case of the ST monad, I
shouldn't need such a big hammer as RankNTypes.

--ken

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


Re: [Haskell-cafe] Crypto-api performance

2011-05-04 Thread Johan Brinch
On Tue, May 3, 2011 at 23:14, Daniel Fischer
daniel.is.fisc...@googlemail.com wrote:
 did you notice that the comment says 128KB strings for ps and lps, but they
 are in fact 1MB strings:

 -- 128KB strings
 ps = B.replicate (2^20) 0
 lps = L.replicate (2^20) 0

 ? If not, the throughput would look much better, wouldn't it?


Ah, I failed to mention this in my previous mail. I changed the test
values from 128KB to 1MB to see if it would help the throughput (by
lowering overhead in the framework). So I've already compensated for
this in the MB/s calculations.

Nice catch, though :-)

-- 
Johan Brinch

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


Re: [Haskell-cafe] Crypto-api performance

2011-05-04 Thread Peter Simons
Also, it appears that crypto-api needs vast amounts of memory when
compiled with optimization enabled. The latest version 0.6.1 is
effectively unbuildable on my EeePC, which has only 1GB RAM. That
property is fairly undesirable for a library package.

Take care,
Peter


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


Re: [Haskell-cafe] runST readSTRef type error

2011-05-04 Thread Edward Z. Yang
Hello Ken,

Strictly speaking, you only need Rank-2 types.  This indeed the right
way to fix the problem. 

Cheers,
Edward

Excerpts from Ken Takusagawa II's message of Wed May 04 02:00:49 -0400 2011:
 I run into the following type error:
 
 foo :: ST s (STRef s Int) - Int
 foo p = (runST (p = readSTRef))
 
 with ghc 6.12.1
 st.hs:8:16:
 Couldn't match expected type `s1' against inferred type `s'
   `s1' is a rigid type variable bound by
the polymorphic type `forall s1. ST s1 a' at st.hs:8:9
   `s' is a rigid type variable bound by
   the type signature for `foo' at st.hs:7:10
   Expected type: ST s1 (STRef s Int)
   Inferred type: ST s (STRef s Int)
 In the first argument of `(=)', namely `p'
 In the first argument of `runST', namely `(p = readSTRef)'
 
 However, if I add
 {-# LANGUAGE RankNTypes #-}
 
 and change the type signature to
 foo :: (forall s.ST s (STRef s Int)) - Int
 
 it works.  I don't fully understand what's going on here.
 
 Is this the right way to fix the problem?  Are there other options?
 My gut feeling is, for such a simple use case of the ST monad, I
 shouldn't need such a big hammer as RankNTypes.
 
 --ken
 

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


Re: [Haskell-cafe] runST readSTRef type error

2011-05-04 Thread Maciej Marcin Piechotka
On Wed, 2011-05-04 at 02:00 -0400, Ken Takusagawa II wrote:
 I run into the following type error:
 
 foo :: ST s (STRef s Int) - Int
 foo p = (runST (p = readSTRef))
 
 with ghc 6.12.1
 st.hs:8:16:
 Couldn't match expected type `s1' against inferred type `s'
   `s1' is a rigid type variable bound by
the polymorphic type `forall s1. ST s1 a' at st.hs:8:9
   `s' is a rigid type variable bound by
   the type signature for `foo' at st.hs:7:10
   Expected type: ST s1 (STRef s Int)
   Inferred type: ST s (STRef s Int)
 In the first argument of `(=)', namely `p'
 In the first argument of `runST', namely `(p = readSTRef)'
 
 However, if I add
 {-# LANGUAGE RankNTypes #-}
 
 and change the type signature to
 foo :: (forall s.ST s (STRef s Int)) - Int
 
 it works.  I don't fully understand what's going on here.
 
 Is this the right way to fix the problem?  Are there other options?
 My gut feeling is, for such a simple use case of the ST monad, I
 shouldn't need such a big hammer as RankNTypes.
 
 --ken

To make the interface of ST works - i.e. to keeps it pure the signature
of runST is:

 runST :: (forall s. ST s a) - a

Otherwise consider following code:

 incST :: Num a = STRef s a - ST s a
 incST r = readSTRef r = \v - writeSTRef r (v + 1)  return v

 add :: STRef s Int - Int - Int
 add r x = runST (incST r = \v - return (v + x))

 test :: [Int]
 test = runST (newSTRef 0) = \r - map (add r) [1,2,3]

What is the result?

And what is the result of:

 test2 :: [Int]
 test2 = runST (newSTRef 0) = \r - map (add r) (map (add r) [1,2,3])

Regards


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] Please add a method for optimized concat to the Semigroup class

2011-05-04 Thread John Lato

 From: Edward Kmett ekm...@gmail.com

 On Tue, May 3, 2011 at 3:43 PM, Yitzchak Gale g...@sefer.org wrote:

  I'm sure there are countless other natural examples of semigroups
  in the wild, and that the typical non-trivial ones will benefit
  from an optimized sconcat.
 

 Sold! (modulo the semantic considerations above)


Somewhat academic, but would there be a case for implementing sconcat in
terms of Foldable (or similar)?

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


Re: [Haskell-cafe] Please add a method for optimized concat to the Semigroup class

2011-05-04 Thread Edward Kmett
On Wed, May 4, 2011 at 7:40 AM, John Lato jwl...@gmail.com wrote:

 From: Edward Kmett ekm...@gmail.com


 On Tue, May 3, 2011 at 3:43 PM, Yitzchak Gale g...@sefer.org wrote:

  I'm sure there are countless other natural examples of semigroups
  in the wild, and that the typical non-trivial ones will benefit
  from an optimized sconcat.
 

 Sold! (modulo the semantic considerations above)


 Somewhat academic, but would there be a case for implementing sconcat in
 terms of Foldable (or similar)?


There is a Foldable1 in semigroupoids. I could move it into the semigroups
package, but at the consequence that Data.Semigroup.Foldable wouldn't look
like Data.Foldable API-wise, since the Semigroupoid package is what
introduces Apply and Bind, giving you an Applicative sans pure and a Monad
sans return, which are needed to make most of the analogues to the Foldable
functions.

So to do so, I'd need to move those into this package. This is not entirely
implausible, if somewhat inconvenient from the perspective of keeping the
semigroups package tiny. The default definition would wind up being
something like:

class Semigroup a where
   () :: a - a - a

   sconcat :: Foldable1 f = f a - a
   sconcat = fold1

class Foldable f = Foldable1 f where
   fold1 :: Semigroup a = f a - a
   fold1 = foldMap1 id

   foldMap1 :: Semigroup a = (b - a) - f b - a
   foldMap1 = ...

   foldr1 :: ...

   foldl1 :: ...

choosing sconcat = fold1 by default seems pretty much optimal under those
conditions, saying that if your Semigroup doesn't have an optimized fold,
you might as well let the container figure out what to do instead.

If we do that though, I'm hard pressed to find anything better to specialize
to for most semigroups, which is what I was saying earlier to Yitzchak, and
why I had omitted sconcat from the original API.

I suppose you might exploit foldl, foldr, foldl' or foldr' instead to play a
bit with how your traversal associates by default, or to use a different,
more efficient intermediate state though.

However, I am somewhat worried that with the type of the container
abstracted that it probably won't receive the same love from the strictness
analyzer though.

One other annoying implementation consequence is that it would make the
Data.Semigroup and Data.Semigroup.Foldable modules rather hopelessly
entangled, so that I'd have to factor out the classes into a common
Internals module, then re-export the appropriate fragments through separate
modules. =/

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


Re: [Haskell-cafe] Fwd: Re: Binary and Serialize classes

2011-05-04 Thread Evan Laforge
On Tue, May 3, 2011 at 7:13 AM, Alberto G. Corona agocor...@gmail.com wrote:
 E1610With the exception of heavy  serialization usage, for example, in very
 optimized RPC applications (and even there SOAP shows that this is not ever
 the case), text serialization is better. The unwritten rules of good design
 says that data representation and compression must be orthogonal. The binary
 formats were designed for performing both functionalities in the times when
 memory were measured in Kbytes.

Actually, I'm using binary because it seems simpler.  If it were text,
I'd have to come up with some text format.  I'd either have to invent
some ad-hoc new language or figure out how to fit it into some generic
format like JSON.  There would be parsing, an intermediate format,
conversion, typechecking, blah blah.  All this complexity for what
exactly?  So people could edit the serialized output with a text
editor?  Why don't they edit it with my program, which is designed for
that?  At least just import the deserialize module and edit the typed
data structure in the REPL.  And say people do start editing it with
text editors... now the format is inching toward public, and I can't
change it without breaking someone's text editor habits.

In fact, if I serialize the same data with Data.Serialize and with
'show', the binary version is slightly larger!  I imagine it's because
zeros in text format can fit in a few bytes, while in binary they
always take the full 32 or 64 bits (or 128 for the default Double
serialization!).  So for me at least, it has nothing to do with
compression.

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


[Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Barbara Shirtcliff
Hi,

In the following solution to problem 24, why is nub ignored?
I.e. if you do lexOrder of 0012, you get twice as many permutations as with 
012, even though I have used nub.

puzzled,
Bar

-- file Euler.hs

module Euler where
import Data.List

{-

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?

-}

lexI :: Char - String - Int
lexI c s = maybe 1 (id) $ elemIndex c s

lexOrder :: [Char] - [[Char]]
lexOrder s
 | length s == 1= [s]
 | length s == 2= z : [reverse z]
 | otherwise= concat $ map (\n - h n) [0..((length s) - 1)]
where z = sort $ nub s -- why is the nub ignored here?
  h :: Int - [String]
  h n = map (z!!n :) $ lexOrder $ filter (\c - lexI c 
z /= n) z

p24 = (lexOrder 1234567890)!!99

main :: IO()
main = 
do
   putStrLn $ show $ p24
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Chris Smith
On Wed, 2011-05-04 at 07:13 -0600, Barbara Shirtcliff wrote:
 In the following solution to problem 24, why is nub ignored?
 I.e. if you do lexOrder of 0012, you get twice as many permutations as with 
 012, even though I have used nub.

 lexOrder :: [Char] - [[Char]]
 lexOrder s
  | length s == 1= [s]
  | length s == 2= z : [reverse z]
  | otherwise= concat $ map (\n - h n) [0..((length s) - 1)]
 where z = sort $ nub s -- why is the nub ignored here?
   h :: Int - [String]
   h n = map (z!!n :) $ lexOrder $ filter (\c - lexI 
 c z /= n) z

You are using (length s) in the otherwise case.  If you want the results
to be identical with duplicates, perhaps you meant to say (length z)?

-- 
Chris


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


Re: [Haskell-cafe] Please add a method for optimized concat to the Semigroup class

2011-05-04 Thread John Lato
On Wed, May 4, 2011 at 1:25 PM, Edward Kmett ekm...@gmail.com wrote:

 On Wed, May 4, 2011 at 7:40 AM, John Lato jwl...@gmail.com wrote:

 From: Edward Kmett ekm...@gmail.com


 On Tue, May 3, 2011 at 3:43 PM, Yitzchak Gale g...@sefer.org wrote:

  I'm sure there are countless other natural examples of semigroups
  in the wild, and that the typical non-trivial ones will benefit
  from an optimized sconcat.
 

 Sold! (modulo the semantic considerations above)


 Somewhat academic, but would there be a case for implementing sconcat in
 terms of Foldable (or similar)?


 There is a Foldable1 in semigroupoids. I could move it into the semigroups
 package, but at the consequence that Data.Semigroup.Foldable wouldn't look
 like Data.Foldable API-wise, since the Semigroupoid package is what
 introduces Apply and Bind, giving you an Applicative sans pure and a Monad
 sans return, which are needed to make most of the analogues to the Foldable
 functions.

 So to do so, I'd need to move those into this package. This is not entirely
 implausible, if somewhat inconvenient from the perspective of keeping the
 semigroups package tiny. The default definition would wind up being
 something like:

 class Semigroup a where
() :: a - a - a

sconcat :: Foldable1 f = f a - a
sconcat = fold1

 class Foldable f = Foldable1 f where
fold1 :: Semigroup a = f a - a
fold1 = foldMap1 id

foldMap1 :: Semigroup a = (b - a) - f b - a
foldMap1 = ...

foldr1 :: ...

foldl1 :: ...

 choosing sconcat = fold1 by default seems pretty much optimal under those
 conditions, saying that if your Semigroup doesn't have an optimized fold,
 you might as well let the container figure out what to do instead.

 If we do that though, I'm hard pressed to find anything better to
 specialize to for most semigroups, which is what I was saying earlier to
 Yitzchak, and why I had omitted sconcat from the original API.

 I suppose you might exploit foldl, foldr, foldl' or foldr' instead to play
 a bit with how your traversal associates by default, or to use a different,
 more efficient intermediate state though.

 However, I am somewhat worried that with the type of the container
 abstracted that it probably won't receive the same love from the strictness
 analyzer though.

 One other annoying implementation consequence is that it would make the
 Data.Semigroup and Data.Semigroup.Foldable modules rather hopelessly
 entangled, so that I'd have to factor out the classes into a common
 Internals module, then re-export the appropriate fragments through separate
 modules. =/


Good points.  I was hoping for a reply like this, since I don't have a good
intuition for how Foldable would fit into the semigroups package.  I don't
have a strong opinion in either direction.

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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Ivan Lazar Miljenovic
On 4 May 2011 13:13, Barbara Shirtcliff ba...@gmx.com wrote:
 Hi,

 In the following solution to problem 24, why is nub ignored?
 I.e. if you do lexOrder of 0012, you get twice as many permutations as with 
 012, even though I have used nub.

 [snip]

 lexOrder :: [Char] - [[Char]]
 lexOrder s
  | length s == 1    = [s]
  | length s == 2    = z : [reverse z]
  | otherwise        = concat $ map (\n - h n) [0..((length s) - 1)]
                    where z = sort $ nub s -- why is the nub ignored here?
                          h :: Int - [String]
                          h n = map (z!!n :) $ lexOrder $ filter (\c - lexI c 
 z /= n) z

As a guess, I think it's from the usage of length on the right-hand size.

Also, note that lexOrder s@[_] = [s] is nicer than lexOrder s |
length s == 1 = [s].

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com

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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Barbara Shirtcliff
Ah, thanks!


On May 4, 2011, at 7:21 AM, Ivan Lazar Miljenovic wrote:

 On 4 May 2011 13:13, Barbara Shirtcliff ba...@gmx.com wrote:
 Hi,
 
 In the following solution to problem 24, why is nub ignored?
 I.e. if you do lexOrder of 0012, you get twice as many permutations as 
 with 012, even though I have used nub.
 
 [snip]
 
 lexOrder :: [Char] - [[Char]]
 lexOrder s
  | length s == 1= [s]
  | length s == 2= z : [reverse z]
  | otherwise= concat $ map (\n - h n) [0..((length s) - 1)]
where z = sort $ nub s -- why is the nub ignored here?
  h :: Int - [String]
  h n = map (z!!n :) $ lexOrder $ filter (\c - lexI 
 c z /= n) z
 
 As a guess, I think it's from the usage of length on the right-hand size.
 
 Also, note that lexOrder s@[_] = [s] is nicer than lexOrder s |
 length s == 1 = [s].
 
 -- 
 Ivan Lazar Miljenovic
 ivan.miljeno...@gmail.com
 IvanMiljenovic.wordpress.com


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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Daniel Fischer
On Wednesday 04 May 2011 15:13:07, Barbara Shirtcliff wrote:
 Hi,
 
 In the following solution to problem 24, why is nub ignored?

It isn't:

*LexOrder lexOrder 00
[0,0]
*LexOrder lexOrder 001
[01,10,*** Exception: Prelude.(!!): index too large


 
 lexI :: Char - String - Int
 lexI c s = maybe 1 (id) $ elemIndex c s
 
 lexOrder :: [Char] - [[Char]]
 lexOrder s
 
  | length s == 1= [s]
  | length s == 2= z : [reverse z]
  | otherwise= concat $ map (\n - h n) [0..((length s) - 1)]
 
 where z = sort $ nub s -- why is the nub ignored
 here? h :: Int - [String]
   h n = map (z!!n :) $ lexOrder $ filter (\c -
 lexI c z /= n) z

Your problem is (well, the one I see immediately) that you check for the 
length of s, where you should check for the length of z.

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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Barbara Shirtcliff

On May 4, 2011, at 7:21 AM, Ivan Lazar Miljenovic wrote:

 On 4 May 2011 13:13, Barbara Shirtcliff ba...@gmx.com wrote:
 Hi,
 
 In the following solution to problem 24, why is nub ignored?
 I.e. if you do lexOrder of 0012, you get twice as many permutations as 
 with 012, even though I have used nub.
 
 [snip]
 
 lexOrder :: [Char] - [[Char]]
 lexOrder s
  | length s == 1= [s]
  | length s == 2= z : [reverse z]
  | otherwise= concat $ map (\n - h n) [0..((length s) - 1)]
where z = sort $ nub s -- why is the nub ignored here?
  h :: Int - [String]
  h n = map (z!!n :) $ lexOrder $ filter (\c - lexI 
 c z /= n) z
 
 As a guess, I think it's from the usage of length on the right-hand size.
 
 Also, note that lexOrder s@[_] = [s] is nicer than lexOrder s |
 length s == 1 = [s].

I agree that that initial version was a little clumsy, but your suggestion 
doesn't really seem to work:


lexOrder :: [Char] - [[Char]]
lexOrder s@[_] = s
lexOrder s =
 concat $ map (\n - h n) [0..((length z) - 1)]
 where z = sort $ nub s 
   h :: Int - [String]
   h n = map (z!!n :) $ lexOrder $ filter (\c - lexI c z /= n) z


Euler.hs:8:18:
Couldn't match expected type `[Char]' with actual type `Char'
Expected type: [[Char]]
  Actual type: [Char]
In the expression: s
In an equation for `lexOrder': lexOrder s@[_] = s




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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Artyom Kazak
Barbara Shirtcliff ba...@gmx.com писал(а) в своём письме Wed, 04 May  
2011 16:41:07 +0300:



Also, note that lexOrder s@[_] = [s] is nicer than lexOrder s |
length s == 1 = [s].


I agree that that initial version was a little clumsy, but your  
suggestion doesn't really seem to work:



lexOrder :: [Char] - [[Char]]
lexOrder s@[_] = s
lexOrder s =
 concat $ map (\n - h n) [0..((length z) - 1)]
 where z = sort $ nub s
   h :: Int - [String]
   h n = map (z!!n :) $ lexOrder $ filter (\c - lexI c z /=  
n) z



Euler.hs:8:18:
Couldn't match expected type `[Char]' with actual type `Char'
Expected type: [[Char]]
  Actual type: [Char]
In the expression: s
In an equation for `lexOrder': lexOrder s@[_] = s


It actually works, you have forgotten square brackets: lexOrder s@[_] =  
[s]   --not s!.


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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Barbara Shirtcliff

On May 4, 2011, at 9:18 AM, Artyom Kazak wrote:

 Barbara Shirtcliff ba...@gmx.com писал(а) в своём письме Wed, 04 May 2011 
 16:41:07 +0300:
 
 Also, note that lexOrder s@[_] = [s] is nicer than lexOrder s |
 length s == 1 = [s].
 
 I agree that that initial version was a little clumsy, but your suggestion 
 doesn't really seem to work:
 
 
 lexOrder :: [Char] - [[Char]]
 lexOrder s@[_] = s
 lexOrder s =
 concat $ map (\n - h n) [0..((length z) - 1)]
 where z = sort $ nub s
   h :: Int - [String]
   h n = map (z!!n :) $ lexOrder $ filter (\c - lexI c z /= n) z
 
 
 Euler.hs:8:18:
Couldn't match expected type `[Char]' with actual type `Char'
Expected type: [[Char]]
  Actual type: [Char]
In the expression: s
In an equation for `lexOrder': lexOrder s@[_] = s
 
 It actually works, you have forgotten square brackets: lexOrder s@[_] = [s]  
  --not s!.

Прабда!  Спасибо

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


[Haskell-cafe] Another good video tutorial on monads

2011-05-04 Thread C K Kashyap
http://vimeo.com/20717301
I really liked how he starts off with the let statement.
Regards,
Kashyap
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't install haskellnet with ghc7

2011-05-04 Thread Charles-Pierre Astolfi
I tried to install haskellnet with mime-mail-0.2.x and an older
version of the text library but it still fails with the same error.

Btw, what is the best way to uninstall a package that has been
installed via cabal? (or to downgrade it, fwiw)

--
Cp



On Tue, Apr 26, 2011 at 23:31, Vincent Hanquez t...@snarc.org wrote:
  On 04/26/2011 10:17 PM, Charles-Pierre Astolfi wrote:

 Hi -cafe,

 Did anybody managed to install haskellnet from hackage with ghc7?
 I tried on windows and mac and I get the following type error:

 [ 4 of 11] Compiling Network.HaskellNet.SMTP (
 Network/HaskellNet/SMTP.hs, dist/build/Network/HaskellNet/SMTP.o )
 Network/HaskellNet/SMTP.hs:269:25:
     Couldn't match expected type `Data.Text.Internal.Text'
                 with actual type `[Char]'
     Expected type: Data.Text.Internal.Text
       Actual type: String
     In the first argument of `simpleMail', namely `to'
     In a stmt of a 'do' expression:
         myMail- simpleMail to from subject plainBody htmlBody attachments

 Am I missing something?

 your mime-mail library is too recent.
 the upper version in the cabal file of haskellnet is not limited, so it's
 picking up the 0.3.0 version which is incompatible with the 0.2.x.

 Otherwise it was working for me with the previous version for both ghc6 and
 ghc7.

 --
 Vincent


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


Re: [Haskell-cafe] Advertisement: the Haskell Stack Overflow Q A site

2011-05-04 Thread Andrew Coppin

One of the benefits of a site like SO as a forum is the ability to
record and link to prior work, edit for technical errors, and easily
search and categorize past answers. It is also less prone to noise,
for those suffering from cafe overload.


I would also recommend SO.


My only experience of SO is that I asked a question once, and to this 
day it has still only been viewed a grand total of 6 times. (And I think 
that was just me looking to see if there were any replies yet.) OTOH, it 
wasn't Haskell-related.


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


[Haskell-cafe] Can't build Gtk2hs on Windows

2011-05-04 Thread Andrew Coppin

Today I tried to install Gtk2hs. Big mistake!

Last time I tried it, it was quite easy. Now that it uses Cabal, even on 
Windows you can compile this stuff from source fairly easily. It's just 
that you have to fiddle with environment variables to make it find stuff.


However...

1. Since the move of haskell.org, the gtk2hs homepage has vanished off 
the face of the Earth. Is there any danger we might get this back some day?


2. http://hackage.haskell.org/trac/gtk2hs/ticket/1203

(In other words, every time you try to cabal install a GTK-related 
package, it fails during the register step, and you need to hand-edit 
Gtk2HsSetup.hs to fix the issue.)


3. http://hackage.haskell.org/trac/gtk2hs/ticket/1209

(In other words, certain GTK-related packages just plain fail to build 
due to undefined names or missing header files or...)


In summary, it's just utterly broken. Which is very frustrating, given 
that not so long ago it was working really well. (I never did get Glade 
to work though... although it looks like that might be fixed now, if I 
could just get past all the other issues.)


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


Re: [Haskell-cafe] Advertisement: the Haskell Stack Overflow Q A site

2011-05-04 Thread James Cook

On May 4, 2011, at 4:50 PM, Andrew Coppin wrote:


   One of the benefits of a site like SO as a forum is the ability to
   record and link to prior work, edit for technical errors, and  
easily
   search and categorize past answers. It is also less prone to  
noise,

   for those suffering from cafe overload.


I would also recommend SO.


My only experience of SO is that I asked a question once, and to  
this day it has still only been viewed a grand total of 6 times.  
(And I think that was just me looking to see if there were any  
replies yet.) OTOH, it wasn't Haskell-related.


I think Haskell questions on SO tend to the opposite extreme; no  
matter how poorly thought-out the question, the Haskell community will  
descend on it like a swarm of helpful piranhas.


Languages like Java and C# have such an overwhelmingly huge number of  
questions (the quality of which are, frankly, quite poor on average)  
that very few people are going to actually sit and look through even  
1% of them.  Haskell, on the other hand, has a small enough volume  
that people can at least skim the ones from the last past day or two  
in a fairly small amount of time.


-- James

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


Re: [Haskell-cafe] Advertisement: the Haskell Stack Overflow Q A site

2011-05-04 Thread Daniel Fischer
On Wednesday 04 May 2011 23:02:35, James Cook wrote:
 I think Haskell questions on SO tend to the opposite extreme; no  
 matter how poorly thought-out the question, the Haskell community will  
 descend on it like a swarm of helpful piranhas.

That's a great picture. I like it.
Haskell, where helpful piranhas swim :D

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


Re: [Haskell-cafe] Advertisement: the Haskell Stack Overflow Q A site

2011-05-04 Thread Casey McCann
On Wed, May 4, 2011 at 5:02 PM, James Cook mo...@deepbondi.net wrote:
  Haskell, on the other hand, has a small enough volume that people can at
 least skim the ones from the last past day or two in a fairly small amount
 of time.

They can and, in fact, do. Or at least I do, at any rate, even when I
don't really have time to answer any. And I suspect Don Stewart does
as well since by himself he's something like 20% of the answers by
volume. Suffice it to say, questions with the [haskell] tag don't get
overlooked.

Overall, based on my experiences and glancing at the question lists,
I'd estimate that most questions tagged [haskell] get at least 50
views and at least one useful answer within a few hours of being
posted, depending on time of day and how many of the more prolific
answerers are around. There're maybe 25 questions with no answers at
all, which is less than 1% of the questions in the tag, and of the
unanswered questions many are either very poorly thought out, very
difficult to answer, or highly specific to some tool or library that
not everyone may be familiar with.

- C.

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


Re: [Haskell-cafe] Can't build Gtk2hs on Windows

2011-05-04 Thread Ryan Yates
On Wed, May 4, 2011 at 4:58 PM, Andrew Coppin
andrewcop...@btinternet.com wrote:
 2. http://hackage.haskell.org/trac/gtk2hs/ticket/1203

Another workaround for this is to install global:

cabal install cairo --global



Ryan

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


Re: [Haskell-cafe] Can't build Gtk2hs on Windows

2011-05-04 Thread Daniel Fischer
On Wednesday 04 May 2011 22:58:48, Andrew Coppin wrote:
 Today I tried to install Gtk2hs. Big mistake!
 
 Last time I tried it, it was quite easy. Now that it uses Cabal, even on
 Windows you can compile this stuff from source fairly easily. It's just
 that you have to fiddle with environment variables to make it find
 stuff.
 
 However...
 
 1. Since the move of haskell.org, the gtk2hs homepage has vanished off
 the face of the Earth. Is there any danger we might get this back some
 day?
 
 2. http://hackage.haskell.org/trac/gtk2hs/ticket/1203
 
 (In other words, every time you try to cabal install a GTK-related
 package, it fails during the register step, and you need to hand-edit
 Gtk2HsSetup.hs to fix the issue.)

Not here.

 
 3. http://hackage.haskell.org/trac/gtk2hs/ticket/1209
 
 (In other words, certain GTK-related packages just plain fail to build
 due to undefined names or missing header files or...)

Not here.

 
 In summary, it's just utterly broken.

Hmm, not so easy. It seems to work fine on linux (I only installed gtk* 
stuff for trying out leksah, so things might break with other stuff, but 
gtk, gio, glib, cairo, pango, gtksourceview2 went through without so much 
as a hiccough).

So, by the looks of it, it seems to just work  on linux, break on OS X 
and Windows, which might make it hard to pin down.

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


Re: [Haskell-cafe] Can't install haskellnet with ghc7

2011-05-04 Thread Daniel Fischer
On Wednesday 04 May 2011 21:57:51, Charles-Pierre Astolfi wrote:
 I tried to install haskellnet with mime-mail-0.2.x and an older
 version of the text library but it still fails with the same error.

I just did

$ cabal install --constraint=mime-mail  0.3 HaskellNet

and it worked fine (ghc-7.0.3), text-0.11.0.7.

Try the above with the --dry-run flag first, if it says it would install 
packages which you already have (except mime-mail), that may indicate 
problems, otherwise go ahead.

 
 Btw, what is the best way to uninstall a package that has been
 installed via cabal? (or to downgrade it, fwiw)

$ ghc-pkg unregister mime-mail-0.3.0

perhaps? cabal has no uninstall command, so that job is for ghc-pkg 
unregister, unless you're willing to delete the whole ~/.ghc/i386-
linux-7.0.3 and start from next to nothing.

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


Re: [Haskell-cafe] warning - Euler problem spoiler enclosed

2011-05-04 Thread Tobias Schoofs

The problem is
  lexOrder s@[_] = s
where you just give back what you receive, i.e. [Char].
But you claim to give back [[Char]].
Try [s] on the right-hand side.

On 05/04/2011 02:41 PM, Barbara Shirtcliff wrote:

On May 4, 2011, at 7:21 AM, Ivan Lazar Miljenovic wrote:


On 4 May 2011 13:13, Barbara Shirtcliffba...@gmx.com  wrote:

Hi,

In the following solution to problem 24, why is nub ignored?
I.e. if you do lexOrder of 0012, you get twice as many permutations as with 
012, even though I have used nub.

[snip]

lexOrder :: [Char] -  [[Char]]
lexOrder s
  | length s == 1= [s]
  | length s == 2= z : [reverse z]
  | otherwise= concat $ map (\n -  h n) [0..((length s) - 1)]
where z = sort $ nub s -- why is the nub ignored here?
  h :: Int -  [String]
  h n = map (z!!n :) $ lexOrder $ filter (\c -  lexI c 
z /= n) z

As a guess, I think it's from the usage of length on the right-hand size.

Also, note that lexOrder s@[_] = [s] is nicer than lexOrder s |
length s == 1 = [s].

I agree that that initial version was a little clumsy, but your suggestion 
doesn't really seem to work:


lexOrder :: [Char] -  [[Char]]
lexOrder s@[_] = s
lexOrder s =
  concat $ map (\n -  h n) [0..((length z) - 1)]
  where z = sort $ nub s
h :: Int -  [String]
h n = map (z!!n :) $ lexOrder $ filter (\c -  lexI c z /= n) z


Euler.hs:8:18:
 Couldn't match expected type `[Char]' with actual type `Char'
 Expected type: [[Char]]
   Actual type: [Char]
 In the expression: s
 In an equation for `lexOrder': lexOrder s@[_] = s




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



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


Re: [Haskell-cafe] Can't install haskellnet with ghc7

2011-05-04 Thread Robert Wills
I just uploaded a new version of haskellnet that compiles with
mime-mail-0.3.0.

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

Hope that helps -- now for some sleep...

http://hackage.haskell.org/package/HaskellNet-Rob

On Wed, May 4, 2011 at 11:28 PM, Daniel Fischer 
daniel.is.fisc...@googlemail.com wrote:

 On Wednesday 04 May 2011 21:57:51, Charles-Pierre Astolfi wrote:
  I tried to install haskellnet with mime-mail-0.2.x and an older
  version of the text library but it still fails with the same error.

 I just did

 $ cabal install --constraint=mime-mail  0.3 HaskellNet

 and it worked fine (ghc-7.0.3), text-0.11.0.7.

 Try the above with the --dry-run flag first, if it says it would install
 packages which you already have (except mime-mail), that may indicate
 problems, otherwise go ahead.

 
  Btw, what is the best way to uninstall a package that has been
  installed via cabal? (or to downgrade it, fwiw)

 $ ghc-pkg unregister mime-mail-0.3.0

 perhaps? cabal has no uninstall command, so that job is for ghc-pkg
 unregister, unless you're willing to delete the whole ~/.ghc/i386-
 linux-7.0.3 and start from next to nothing.

 ___
 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] Crypto-api performance

2011-05-04 Thread Matthew Ryan Maurer
While I haven't investigated myself, from seeing haskell build processes
in the past this is almost certainly not crypto-api's fault and is in
fact your linker's fault. If you are not using it already, try switching
to gold over ld, it may help.
--Matthew Maurer
On 05/04/2011 04:27 AM, Peter Simons wrote:
 Also, it appears that crypto-api needs vast amounts of memory when
 compiled with optimization enabled. The latest version 0.6.1 is
 effectively unbuildable on my EeePC, which has only 1GB RAM. That
 property is fairly undesirable for a library package.
 
 Take care,
 Peter
 
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe




signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't build Gtk2hs on Windows

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

Just 5 weeks ago,

http://thread.gmane.org/gmane.comp.lang.haskell.cafe/86738/focus=87456

Did anyone see it?

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


[Haskell-cafe] Haskell Weekly News - Issue 180

2011-05-04 Thread Daniel Santa Cruz
   Welcome to issue 180 of the HWN, a newsletter covering developments in
   the [1]Haskell community. This release covers the week of April 24 to
   30, 2011.

Announcements

   Eric Kow suggested (http://goo.gl/bc4JM) the creation of a Haskell
   User Group starter kit.  If you have ideas in this department,
   please see what Eric has started!

   Christopher Done wrote (http://goo.gl/2m7AJ) a response to a blog
   from Cedric entitled Why Scala's Option and Haskell's Maybe types
   won't save you from Null. A lively conversation followed.

   Henning Thielemann started an very interesting thread
   (http://goo.gl/FWyDE) with the title Python is lazier than
   Haskell. (See the quotes of the week for the full quote)

Quotes of the Week

   These quotes are taken from the #haskell channel, and from the
   haskell/haskell-cafe mailing lists.

   * Henning Thielemann: If Haskell is great because of its laziness,
 then Python must be even greater, since it is lazy at the type
 level.

   * Ben Lippmeier: Laziness at the value level causes space leaks, and
 laziness at the type level causes mind leaks. Neither are much fun.
 When people start wanting laziness at the kind level we'll have to
 quarantine them before the virus spreads...

   * Gregg Reynolds: If the designers could find a way to support
 laziness at the programmer level, I for one would be very grateful.

   * Felipe Almeida Lessa: But I am sure that john-millikin-is-great.txt
 must be increasing like a memory leak ;)

   * James Cook: I think Haskell questions on SO tend to the opposite
 extreme; no matter how poorly thought-out the question, the Haskell
 community will descend on it like a swarm of helpful piranhas.

   * Philippa: C++ seeing a renaissance as a functional language, is
 this a bit like rusty nails seeing a renaissance as sex toys for
 masochists?

   * #haskell: aristid preflex: seen FunctorSalad * preflex_ is now
 known as preflex. * copumpkin is now known as postflex. * xplat is
 now known as circumflex. circumflex FunctorSalad was never seen
 on #haskell-world-conquest -4 years, 3 days, 7i minutes and 0
 seconds ago, saying: RELEASE THE KRAKEN!

   * tolkad: Without a standard you are lost, adrift in a sea of
 unspecified semantics. Hold fast to the rules of the specification
 lest you be consumed by ambiguity.

   * Saizan: it's much easier via type theory, 1) prove bottom 2) 
 3) quodlibet

   * dons: Think of a monad as a spacesuit full of nuclear waste in the
 ocean next to a container of apples. Now, you can't put oranges in
 the space suite or the nuclear waste falls in the ocean, *but* the
 apples are carried around anyway, and you just take what you need.

   * tolkad: Perhaps by using it we could modernise haskell by applying
 the principles of the new kind of science

Top Reddit Stories

   * The Irish Times: Functional programming is more than just
esoteric; it's becoming somewhat cool.
 Domain: irishtimes.com, Score: 44, Comments: 6
 On Reddit: http://goo.gl/cfUbb
 Original: http://goo.gl/1nHEY

   * Why Silkapp uses Haskell
 Domain: blog.silkapp.com, Score: 43, Comments: 0
 On Reddit: http://goo.gl/IFREi
 Original: http://goo.gl/1SwNa

   * Harper again: The real point of laziness
 Domain: existentialtype.wordpress.com, Score: 38, Comments: 89
 On Reddit: http://goo.gl/vA8oD
 Original: http://goo.gl/hqcpy

   * Patent 5,893,120 reduced to mathematical formulae (via Haskell)
 Domain: paulspontifications.blogspot.com, Score: 34, Comments: 13
 On Reddit: http://goo.gl/PmB4K
 Original: http://goo.gl/QknmV

   * IO evaluates the Haskell heap
 Domain: blog.ezyang.com, Score: 33, Comments: 3
 On Reddit: http://goo.gl/FzaGV
 Original: http://goo.gl/KNHku

   * Why Haskell?
 Domain: blog.mired.org, Score: 33, Comments: 19
 On Reddit: http://goo.gl/t1r8I
 Original: http://goo.gl/cV6KL

   * Filter and Visualize Data in Seconds with Silk (Haskell-based startup)
 Domain: thenextweb.com, Score: 33, Comments: 18
 On Reddit: http://goo.gl/hA9HF
 Original: http://goo.gl/NIR3U

   * Haskell libraries you should use
 Domain: blog.johantibell.com, Score: 29, Comments: 3
 On Reddit: http://goo.gl/PPTWG
 Original: http://goo.gl/LmbT6

   * Tying the Knot - a really mind bending Haskell technique
 Domain: haskell.org, Score: 27, Comments: 8
 On Reddit: http://goo.gl/iEdSM
 Original: http://goo.gl/5Zg6f

   * haskell.org GSoC accepted projects are up.
 Domain: self.haskell, Score: 26, Comments: 32
 On Reddit: http://goo.gl/mnrl9
 Original: 
/r/haskell/comments/gxj1h/haskellorg_gsoc_accepted_projects_are_up/

Top StackOverflow Questions

   * What are the best Haskell libraries to operationalize a program?
 votes: 57, answers: 3
 Read on SO: http://goo.gl/rYQiL

   * How do you design programs in Haskell or other