Re: [Haskell-cafe] Hackage is down?

2012-08-12 Thread Henk-Jan van Tuyl
On Sat, 11 Aug 2012 21:10:24 +0200, Justin Greene  
justin.j.gre...@gmail.com wrote:


Anyone have a download link for the haskell platform for windows?  I  
can't

find one with hackage down.



This link depends on the OS you are using; I found the Haskell Platform  
page in the Web Archive[0]. The downloads are at the Galois site[1].


Regards,
Henk-Jan van Tuyl


[0]  
http://web.archive.org/web/20110716180206/http://hackage.haskell.org/platform/

[1] http://lambda.galois.com/hp-tmp/2011.2.0.1/


--
http://Van.Tuyl.eu/
http://members.chello.nl/hjgtuyl/tourdemonad.html
Haskell programming
--

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


Re: [Haskell-cafe] Data structure containing elements which are instances of the same type class

2012-08-12 Thread Heinrich Apfelmus

Antoine Latter wrote:

It should be pretty easy to write an adapter function of type String -
(Show a = a).


The type needs to be

   String - (exists a. Show a = a)

which is equivalent to

   String - (forall a. Show a = a - c) - c


Here is the implementation of the adapter

   newtype ExistsShow = E { showE :: String }
   instance Show ExistsShow where
   show = showE

   withShow :: String - (forall a. Show a = a - c) - c
   withShow s f = f (E s)

Essentially, the point is that the types are equivalent

   ExistsShow  ==  exists a. Show a = a


Best regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com


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


Re: [Haskell-cafe] Data structure containing elements which are instances of the same type class

2012-08-12 Thread Daniel Trstenjak

Hi Oleg,

On Sat, Aug 11, 2012 at 08:14:47AM -, o...@okmij.org wrote:
 I'd like to point out that the only operation we can do on the first
 argument of MkFoo is to show to it. This is all we can ever do:
 we have no idea of its type but we know we can show it and get a
 String. Why not to apply show to start with (it won't be evaluated
 until required anyway)?

It's only a test case. The real thing is for a game and will be
something like:

class EntityT e where
   update  :: e - e

   render  :: e - IO ()

   handleEvent :: e - Event - e

   getBound:: e - Maybe Bound


data Entity = forall e. (EntityT e) = Entity e

data Level = Level {
   entities = [Entity],
   ...
   }


Greetings,
Daniel

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


Re: [Haskell-cafe] Hackage is down?

2012-08-12 Thread Leonard Wörteler
Am 12.08.2012 08:14, schrieb Henk-Jan van Tuyl:
 [1] http://lambda.galois.com/hp-tmp/2011.2.0.1/

The current version is 2012.2.0.0, it can be found here:
http://lambda.haskell.org/platform/download/current/

Cheers, Leo Wörteler

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


[Haskell-cafe] pattern matching vs if-then-else

2012-08-12 Thread Maarten Faddegon

Hi there,

I am writing a toy compiler in Haskell to further my skills in 
functional programming. One of the functions I wrote is to determine the 
iteration count of a loop. I have a number of different test that I want 
to do and I find myself now testing some of these using pattern matching 
and some properties using an if-then-else construction. I do not 
consider this very pretty.


My question is: are there guidelines of when to use pattern matching and 
when to use if-then-else?


Snippet of the function I mentioned:

---8--- 


itercount (ForLoop
[ ( Assignment update_lcv
(Op2 + (Content update_lcv') update_expr)
  )
]
[(Assignment init_lcv init_expr)]
(TestStmt (Op2  (Content test_lcv) test_expr))
bodyblock)
= if-- All stmts use the same lcv
   test_lcv == init_lcv
 test_lcv == update_lcv
 test_lcv == update_lcv'
-- And the lcv is not updated in the body
 intersect [test_lcv] (blockkills bodyblock) == []
then Just $ simple_itercount init_expr test_expr 
update_expr

else Nothing
itercount _ = Nothing
---8--- 



Thanks,
  Maarten

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


Re: [Haskell-cafe] pattern matching vs if-then-else

2012-08-12 Thread Gregory Collins
On Sun, Aug 12, 2012 at 1:30 PM, Maarten Faddegon 
haskell-c...@maartenfaddegon.nl wrote:

 = if-- All stmts use the same lcv
test_lcv == init_lcv
  test_lcv == update_lcv
  test_lcv == update_lcv'
 -- And the lcv is not updated in the body


This part of the conditional can be written more succinctly as:

all (== test_lcv) [init_lcv, update_lcv, update_lcv']


Re: the if statement, you can also use guard syntax.

G
-- 
Gregory Collins g...@gregorycollins.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Possible bug in Criterion or Statistics package

2012-08-12 Thread Aleksey Khudyakov

On 10.08.2012 22:20, Till Berger wrote:

So I am not sure if this is a bug in Criterion itself, the Statistics
package or any dependency or if I am doing something obviously wrong. I
would be grateful if someone could look into this as it is holding me
back from using Criterion for benchmarking my code.


I would suspect Statistics.Resampling.resample. From quick glance
criterion doesn't use any concurrent stuff. I'll try create smaller test
case


It looks like I'm wrong. I obtained event log from crashing program
and resample completed its work without problems. Crash occured later.
Next
suspect is bootstrapBCA itself. It uses monad-par to obtain
parallelism[1].

I tried to create smaller test case without any success.



[1]
https://github.com/bos/statistics/blob/master/Statistics/Resampling/Bootstrap.hs#L84



Replacing runPar $ parMap with a simple map on that line seems to
fix the bug. At least I could not reproduce it anymore on several runs
with my original test case. So it seems to be a bug in the Par monad
package as this change shouldn't alter the program's behaviour, should it?

Looks like this is the case. But reducing test case to reasonable size 
(e.g. removing most of criterion and statistics could be quite difficult


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


Re: [Haskell-cafe] hGetContents Illegal byte sequence / ghc-pkg

2012-08-12 Thread David Fox
On Sat, Aug 11, 2012 at 4:13 AM, Benjamin Edwards edwards.b...@gmail.comwrote:

 Hello café,

 I have a program that is crashing, and I have no idea why:

 module Main
   where

 import System.Process (readProcessWithExitCode)


 main :: IO ()
 main = do _ - readProcessWithExitCode ghc-pkg [describe, hoopl] 
   putStrLn Should never get here

 this is using the process package from hackage. The program crashes with

 minimal-test: fd:5: hGetContents: invalid argument (invalid byte sequence)
 minimal-test: thread blocked indefinitely in an MVar operation

 inspecting the source of readProcessWithExitCode yields an obvious
 explanation to the MVar problem, but I don't understand why hGetContents is
 so offended.

 For the lazy it is defined as follows:

 readProcessWithExitCode
 :: FilePath -- ^ command to run
 - [String] -- ^ any arguments
 - String   -- ^ standard input
 - IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
 readProcessWithExitCode cmd args input = do
 (Just inh, Just outh, Just errh, pid) -
 createProcess (proc cmd args){ std_in  = CreatePipe,
std_out = CreatePipe,
std_err = CreatePipe }

 outMVar - newEmptyMVar

 -- fork off a thread to start consuming stdout
 out  - hGetContents outh
 _ - forkIO $ C.evaluate (length out)  putMVar outMVar ()

 -- fork off a thread to start consuming stderr
 err  - hGetContents errh
 _ - forkIO $ C.evaluate (length err)  putMVar outMVar ()

 -- now write and flush any input
 when (not (null input)) $ do hPutStr inh input; hFlush inh
 hClose inh -- done with stdin

 -- wait on the output
 takeMVar outMVar
 takeMVar outMVar
 hClose outh
 hClose errh

 -- wait on the process
 ex - waitForProcess pid

 return (ex, out, err)

 Now having looked at the source of ghc-pkg it is dumping it's output using
 putStr and friends, so that should be using my local encoding on the
 system, right? and so should hGetContents in my program..?

 Now, for the curious: the reason I care is that this problem has
 effectively prevented me from using virthualenv. Sadness and woe.


I would recommend using ByteStrings.  There is a link to a version of
readProcessWithExitCode that uses ByteString instead of String here:
http://www.haskell.org/pipermail/libraries/2012-August/018263.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] I use cabal install repa but then WinGHCi says module Data.Array.Rep.Algorithms.Ramdomish not found.

2012-08-12 Thread KC
-- 
--
Regards,
KC

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


[Haskell-cafe] Fixity declaration extension

2012-08-12 Thread Евгений Пермяков
fixity declaration has form *infix(l|r)? [Digit]* in haskell. I'm pretty 
sure, that this is not enough for complicated cases. Ideally, fixity 
declarations should have form *infix(l|r)? [Digit](\.(+|-)[Digit])** , 
with implied infinitely long repeated (.0) tail. This will allow fine 
tuning of operator priorities and much easier priority selection. For 
example, it may be assumed, that bit operations like (..) operator have 
hightest priority and have priorities like 9.0.1 or 9.0.2, anti-lisps 
like ($) have lowest priority like 0.0.1, control operators have base 
priority 1.* and logic operations like () have priority of 2.* and it 
will be possibly to add new operators between or above all (for example) 
control operators without moving fixity of other ones.


Agda2 language supports wide priority range, but still without 'tails' 
to my knowledge. Is there any haskell-influenced language or 
experimental syntactic extension that address the issue?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] but module Data.Array.Rep.Algorithms.Ramdomish is in package repa-algorithms

2012-08-12 Thread Albert Y. C. Lai

On 12-08-12 02:18 PM, KC wrote:
 I use cabal install repa but then WinGHCi says
 module Data.Array.Rep.Algorithms.Ramdomish not found.

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


Re: [Haskell-cafe] but module Data.Array.Rep.Algorithms.Ramdomish is in package repa-algorithms

2012-08-12 Thread Brandon Allbery
email is the new twitter

On Sun, Aug 12, 2012 at 3:21 PM, Albert Y. C. Lai tre...@vex.net wrote:

 On 12-08-12 02:18 PM, KC wrote:
  I use cabal install repa but then WinGHCi says
  module Data.Array.Rep.Algorithms.**Ramdomish not found.

 __**_
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe




-- 
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] I use cabal install repa but then WinGHCi says module Data.Array.Rep.Algorithms.Ramdomish not found.

2012-08-12 Thread Ivan Lazar Miljenovic
I think you need to install repa-algorithms.

On 13 August 2012 04:18, KC kc1...@gmail.com wrote:
 --
 --
 Regards,
 KC

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



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

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


[Haskell-cafe] createProcess running non-existent programs

2012-08-12 Thread Niklas Hambüchen
I just came across the fact that running

createProcess (proc asdfasdf [])

with non-existing command asdfasdf returns perfectly fine handles.
I would expect an exception.
You can even hGetContents on stdout: You just get .

I find this highly counter-intuitive. Is this intended?

Thanks
Niklas


PS: I checked how some other programming languages do this:

Python:
import subprocess; subprocess.call(asdfasdf, shell=False)

OSError: [Errno 2] No such file or directory

Ruby:
exec(asdfasdf)

Errno::ENOENT: No such file or directory - asdfasdf

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