Re: [Haskell-cafe] FunPtr error?

2008-06-13 Thread Galchin, Vasili
oops .. my bad ...

If I change data Sigval = SivalInt Int

to newtype Sigval = SivalInt Int

OR

   data Sigval = SivalPtr (Ptr Char)

to newtype Sigval = SivalPtr (Ptr Char).


Why should "newtype" instead of a data type allow my test case to build?

Vasili



On Fri, Jun 13, 2008 at 10:59 PM, Galchin, Vasili <[EMAIL PROTECTED]>
wrote:

> If I change
>
>  data Sigval = SivalInt Int | SivalPtr (Ptr Char)
> to ...
>
> newtype Sigval = Sivalint Int | SivalPtr (Ptr Char)
>
> then my test case builds and links. ??
>
>
> Regards, Vasili
>
>
>
>
> On Mon, Jun 9, 2008 at 11:01 PM, Galchin, Vasili <[EMAIL PROTECTED]>
> wrote:
>
>> I have tried various things to no avail 
>>
>> [EMAIL PROTECTED]:~/FTP/Haskell/unix-2.2.0.0/tests/timer$ runhaskell
>> Setup.lhs build
>> Preprocessing executables for Test-1.0...
>> Building Test-1.0...
>> [1 of 1] Compiling Main ( ./timer.hs,
>> dist/build/timer/timer-tmp/Main.o )
>>
>> ./timer.hs:22:0:
>> Unacceptable argument type in foreign declaration: Sigval
>> When checking declaration:
>> foreign import ccall safe "wrapper" mkNotify
>>   :: Notify -> IO (FunPtr Notify)
>>
>> => here is my Sigval def
>>
>> data Sigval = SivalInt Int | SivalPtr (Ptr Char)
>>
>> I did a find/grep for "Unacceptable argument" in the ghc compiler source
>> and assuming no typo I didn't find. ??
>>
>> Thanks.
>>
>> Kind regards, Vasili
>>
>>
>>
>>
>>  On Mon, Jun 9, 2008 at 11:25 PM, Judah Jacobson <
>> [EMAIL PROTECTED]> wrote:
>>
>>> 2008/6/9 Galchin, Vasili <[EMAIL PROTECTED]>:
>>> > Ryan,
>>> >
>>> >  I tried but the compiler didn't seem to like the keyword "import":
>>> >
>>> > [EMAIL PROTECTED]:~/FTP/Haskell/unix-2.2.0.0/tests/timer$ runhaskell
>>> > Setup.lhs build
>>> > Preprocessing executables for Test-1.0...
>>> > Building Test-1.0...
>>> > [1 of 1] Compiling Main ( ./timer.hs,
>>> > dist/build/timer/timer-tmp/Main.o )
>>> >
>>> > ./timer.hs:29:8: parse error on input `import'
>>> >
>>>
>>> Hi Vasili,
>>>
>>> To fix that error, you probably just need to add the line "Extensions:
>>> ForeignFunctionInterface" to the .cabal file.   (That is the
>>> equivalent of calling ghc by itself with the command-line arguments
>>> -fffi or -XForeignFunctionInterface.)
>>>
>>> Hope that helps,
>>> -Judah
>>>
>>
>>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] cgi liftM liftIO

2008-06-13 Thread Gwern Branwen
On 2008.06.14 08:05:48 +0200, Adrian Neumann <[EMAIL PROTECTED]> scribbled 4.0K 
characters:
> I think you need to put liftIO in front of the IO actions you want to do
> inside the CGI Monad. Like in this example
>
> > http://www.haskell.org/haskellwiki/
> Practical_web_programming_in_Haskell#File_uploads
>
> (Why did I need to use google to find that? The wiki search in awful.
> Searching for CGI returns nothing, whereas with google the above is the
> first hit.)

IIRC, MediaWiki search will not search for anything shorter than 4 characters 
(as an optimization, I think). This is admittedly annoying when you are 
searching not for 'the' but 'IRC' or 'CGI'...

--
gwern
William Gap subversives Lexis-Nexis SADMS Blowpipe GRU Posse ISCS mailbomb


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


Re: [Haskell-cafe] cgi liftM liftIO

2008-06-13 Thread Adrian Neumann
I think you need to put liftIO in front of the IO actions you want to  
do inside the CGI Monad. Like in this example


> http://www.haskell.org/haskellwiki/ 
Practical_web_programming_in_Haskell#File_uploads


(Why did I need to use google to find that? The wiki search in awful.  
Searching for CGI returns nothing, whereas with google the above is  
the first hit.)


Am 13.06.2008 um 15:41 schrieb Cetin Sert:


Hi,

Could someone please care to explain what I am doing wrong below in  
cgiMain2 and how can I fix it?



./Main.hs:25:15:
No instance for (MonadCGI IO)
  arising from a use of `output' at ./Main.hs:25:15-20
Possible fix: add an instance declaration for (MonadCGI IO)
In the first argument of `($)', namely `output'
In the expression: output $ renderHtml $ page "import" fileForm
In the definition of `upload':
upload = output $ renderHtml $ page "import" fileForm

./Main.hs:57:29:
Couldn't match expected type `CGI CGIResult'
   against inferred type `IO CGIResult'
In the first argument of `handleErrors', namely `cgiMain2'
In the second argument of `($)', namely `handleErrors cgiMain2'
In the expression: runCGI $ handleErrors cgiMain2


import IO
import Network.CGI
import Text.XHtml

import qualified Data.ByteString.Lazy as BS

import Control.Monad (liftM)
import Data.Maybe (fromJust)

import Interact

fileForm = form ! [method "post", enctype "multipart/form-data"] <<
 [afile "file", submit "" "Upload"]

page t b = header << thetitle << t +++ body << b

cgiMain1 = do
  getInputFPS "file" ↠ λms → maybe upload contents ms ↠ return
  where
upload   = output $ renderHtml $ page "import" fileForm
contents = outputFPS

cgiMain2 = do
  getInputFPS "file" ↠ λms → maybe upload contents ms ↠ return
  where
upload   = output $ renderHtml $ page "import" fileForm
contents = λs → do
  (i,o,h,_) ← runUnzip
  BS.hPutStr i s
  c ← BS.hGetContents o
  outputFPS c


{-
  (i,o,h,_) ← runUnzip
  BS.hPutStr i s
  BS.hGetContents o ↠ outputFPS
-}



{-
liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r
liftIO :: (MonadIO m) => IO a -> m a

saveFile n =
do cont <- liftM fromJust $ getInputFPS "file"
   let f = uploadDir ++ "/" ++ basename n
   liftIO $ BS.writeFile f cont
   return $ paragraph << ("Saved as " +++ anchor ! [href f] <<  
f +++ ".")

-}

runUnzip = runInteractiveCommand "unzip -l /dev/stdin"

main = runCGI $ handleErrors cgiMain2

Best Regards,
Cetin Sert

P/s: what are lifts o_O?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe




PGP.sig
Description: Signierter Teil der Nachricht
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] FunPtr error?

2008-06-13 Thread Galchin, Vasili
If I change

 data Sigval = SivalInt Int | SivalPtr (Ptr Char)
to ...

newtype Sigval = Sivalint Int | SivalPtr (Ptr Char)

then my test case builds and links. ??


Regards, Vasili




On Mon, Jun 9, 2008 at 11:01 PM, Galchin, Vasili <[EMAIL PROTECTED]>
wrote:

> I have tried various things to no avail 
>
> [EMAIL PROTECTED]:~/FTP/Haskell/unix-2.2.0.0/tests/timer$ runhaskell
> Setup.lhs build
> Preprocessing executables for Test-1.0...
> Building Test-1.0...
> [1 of 1] Compiling Main ( ./timer.hs,
> dist/build/timer/timer-tmp/Main.o )
>
> ./timer.hs:22:0:
> Unacceptable argument type in foreign declaration: Sigval
> When checking declaration:
> foreign import ccall safe "wrapper" mkNotify
>   :: Notify -> IO (FunPtr Notify)
>
> => here is my Sigval def
>
> data Sigval = SivalInt Int | SivalPtr (Ptr Char)
>
> I did a find/grep for "Unacceptable argument" in the ghc compiler source
> and assuming no typo I didn't find. ??
>
> Thanks.
>
> Kind regards, Vasili
>
>
>
>
>  On Mon, Jun 9, 2008 at 11:25 PM, Judah Jacobson <[EMAIL PROTECTED]>
> wrote:
>
>> 2008/6/9 Galchin, Vasili <[EMAIL PROTECTED]>:
>> > Ryan,
>> >
>> >  I tried but the compiler didn't seem to like the keyword "import":
>> >
>> > [EMAIL PROTECTED]:~/FTP/Haskell/unix-2.2.0.0/tests/timer$ runhaskell
>> > Setup.lhs build
>> > Preprocessing executables for Test-1.0...
>> > Building Test-1.0...
>> > [1 of 1] Compiling Main ( ./timer.hs,
>> > dist/build/timer/timer-tmp/Main.o )
>> >
>> > ./timer.hs:29:8: parse error on input `import'
>> >
>>
>> Hi Vasili,
>>
>> To fix that error, you probably just need to add the line "Extensions:
>> ForeignFunctionInterface" to the .cabal file.   (That is the
>> equivalent of calling ghc by itself with the command-line arguments
>> -fffi or -XForeignFunctionInterface.)
>>
>> Hope that helps,
>> -Judah
>>
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] cabal-install failure

2008-06-13 Thread Gwern Branwen
On 2008.06.13 22:22:06 +0100, Duncan Coutts <[EMAIL PROTECTED]> scribbled 2.1K 
characters:
>
> On Fri, 2008-06-13 at 11:19 -0400, Darrin Thompson wrote:
> > Cabal-install is looking good. It now, for the record, has only two
> > deps outside of Cabal-1.4.
> >
> > I installed cabal-install-0.5 on ubuntu with the haskell.org linux
> > binary for ghc 6.8.2.
> >
> > I then tried cabal-install yi
> >
> > Got this output:
> > ... many successful installs ...
> > Registering vty-3.0.1...
> > Reading package info from "dist/installed-pkg-config" ... done.
> > Saving old package config file... done.
> > Writing new package config file... done.
> > Downloading yi-0.3...
> > [1 of 1] Compiling Main ( Setup.hs, dist/setup/Main.o )
> >
> > Setup.hs:9:0:
> > Warning: Deprecated use of `showPackageId'
> >  (imported from Distribution.Simple, but defined in
> > Distribution.Package):
> >  use the Text class instead
> > Linking dist/setup/setup ...
> > Warning: defaultUserHooks in Setup script is deprecated.
> > Configuring yi-0.3...
> > Warning: Instead of 'ghc-options: -DDYNAMIC -DFRONTEND_VTY' use 
> > 'cpp-options:
> > -DDYNAMIC -DFRONTEND_VTY'
> > setup: alex version >=2.0.1 && <3 is required but it could not be found.
> > cabal: Error: some packages failed to install:
> > yi-0.3 failed during the configure step. The exception was:
> > exit: ExitFailure 1
> >
> > Is this a cabal problem of package problem? I would have expected it
> > to fail immediately instead of discover this problem so far into
> > process.
>
> So it's failing when configuring yi because alex is not installed.
>
> So the question is when should this get checked? I think it's not
> unreasonable to have the check where it is now though perhaps we could
> do better by bringing it forward.
>
> The point is, cabal-install only checks that haskell packages are
> available before beginning to install stuff. It leaves all the other
> checks (build tools, C libs, custom checks in Setup.hs script etc) to be
> done at the configure phase of each package.
>
> In theory it's not impossible to imagine doing the configure phase of
> every package before doing the build phase of any package but it's not
> clear that it gains us that much and it's a bit more complex to do it
> that way.
>
> Duncan

I think this may be Cabal's fault anyway. The yi.cabal includes the line:
 build-tools:   alex >= 2.0.1 && < 3

in the 'executable yi' section, right after the build-depends, so Yi is being 
straightforward and upfront about its needs. Now, Cabal is obviously checking 
that the build-depends is satisfied first, but why isn't it checking that alex 
is available when it has the information it needs to check, presumably anything 
in build-tools is *required*, and the field name suggests that it would be 
checked?

--
gwern
watchers 5.0i Fax UXO NORAD Consulting meta Gatt of data


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


Re: [Haskell-cafe] monomorphism restriction

2008-06-13 Thread Jonathan Cast
On Wed, 2008-06-11 at 20:24 -0700, Don Stewart wrote:
> page:
> > Definition of f:
> >f = foldr (+) 0
> > Types:
> >0 :: (Num t) => t
> >foldr (+) 0 :: Num a => [a] -> a
> >f :: [Integer] -> Integer
> > 
> > Please remind me, again, of the advantages of f being something different 
> > from the formula defining it.
> 
> Overloaded 'constants' take a dictionary as an argument, so while you
> think the value might be computed only once, it make actually be
> recomputed each time. This can be a killer performance penalty for
> overloaded numeric constants.
> 
> Of course, disabling this is pretty simple.

This doesn't apply to f, though --- it has a function type, so the user
presumably already knows it won't be subject to updating, no?
Distinguishing functions from variables by the form of declaration,
rather than the type, seems somewhat questionable to me.

jcc


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


Re: [Haskell-cafe] monomorphism restriction

2008-06-13 Thread Ryan Ingram
On 6/11/08, Rex Page <[EMAIL PROTECTED]> wrote:
> Please remind me, again, of the advantages of f being something different
> from the formula defining it.

fibs !a !b = a : fibs b (a+b)
-- fibs :: Num a => a -> a -> [a]

n = head $ drop 100 $ fibs 1 1
-- n :: Integer (due to monomorphism restriction.)

sumns 0 = 0
sumns x = sumns (x-1) + n

Without the monomorphism restriction, computing n is a function call;
it is evaluated each time it is asked for.

With the monomorphism restriction, n is a CAF and it is updated in
place after it's been evaluated for the first time.

Evaluating "sumns 1000" could take 1000 times as long without the
monomorphism restriction, which definitely seems surprising as a user
until you understand whatis going on behind the scenes with dictionary
passing.

If you do not want the MR, you have these options:
1) turn off explicitly (in GHC you can use -fno-monomorphism restriction)
2) add a type signature yourself (f :: Num a => [a] -> a)
3) eta-expand (f xs = foldr (+) 0 xs)

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


Re: [Haskell-cafe] LDAP 0.6.3 build failure

2008-06-13 Thread Judah Jacobson
On Fri, Jun 13, 2008 at 4:39 PM, Jason Dusek <[EMAIL PROTECTED]> wrote:
>  I'm trying to build the LDAP libs, version 0.6.3, on a recent
>  MacBook Air with OpenLDAP 2.3.27 (the version of OpenLDAP
>  shipped by Apple).
>
>  The "atom sorting error" I get from `ld` is outside my range
>  of knowledge -- if some could advise me on how to get around
>  it, I'd be much obliged. I'm using the Apple toolchain to do
>  do the build.
>

That "error" is actually a harmless warning; in my experience it can
be safely ignored.  More information at:

http://www.nabble.com/Re%3A--Fwd%3A-Re%3A-Problem-building-hdbc-sqlite3-with-ghc-6.8.2--p14602140.html

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


[Haskell-cafe] LDAP 0.6.3 build failure

2008-06-13 Thread Jason Dusek
  I'm trying to build the LDAP libs, version 0.6.3, on a recent
  MacBook Air with OpenLDAP 2.3.27 (the version of OpenLDAP
  shipped by Apple).

  The "atom sorting error" I get from `ld` is outside my range
  of knowledge -- if some could advise me on how to get around
  it, I'd be much obliged. I'm using the Apple toolchain to do
  do the build.

-- 
_jsn


 :; Setup configure && Setup build
Configuring LDAP-0.6.3...
Preprocessing library LDAP-0.6.3...
Building LDAP-0.6.3...
ar: creating archive dist/build/libHSLDAP-0.6.3.a
ld: atom sorting error for
_LDAPzm0zi6zi3_LDAPziTypesLL_Berval_closure_tbl and
_LDAPzm0zi6zi3_LDAPziTypesLL_CLDAP_closure_tbl in
dist/build/LDAP/TypesLL.o
ld: atom sorting error for
_LDAPzm0zi6zi3_LDAPziTypesLL_Berval_closure_tbl and
_LDAPzm0zi6zi3_LDAPziTypesLL_CLDAP_closure_tbl
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANN: Haddock Trac

2008-06-13 Thread David Waern
Hi everyone,

there's now a Haddock bug-tracker and wiki at
http://trac.haskell.org/haddock. Please use it to submit bug reports
and feature requests!

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


Re: [Haskell-cafe] cabal-install failure

2008-06-13 Thread Duncan Coutts

On Fri, 2008-06-13 at 11:19 -0400, Darrin Thompson wrote:
> Cabal-install is looking good. It now, for the record, has only two
> deps outside of Cabal-1.4.
> 
> I installed cabal-install-0.5 on ubuntu with the haskell.org linux
> binary for ghc 6.8.2.
> 
> I then tried cabal-install yi
> 
> Got this output:
> ... many successful installs ...
> Registering vty-3.0.1...
> Reading package info from "dist/installed-pkg-config" ... done.
> Saving old package config file... done.
> Writing new package config file... done.
> Downloading yi-0.3...
> [1 of 1] Compiling Main ( Setup.hs, dist/setup/Main.o )
> 
> Setup.hs:9:0:
> Warning: Deprecated use of `showPackageId'
>  (imported from Distribution.Simple, but defined in
> Distribution.Package):
>  use the Text class instead
> Linking dist/setup/setup ...
> Warning: defaultUserHooks in Setup script is deprecated.
> Configuring yi-0.3...
> Warning: Instead of 'ghc-options: -DDYNAMIC -DFRONTEND_VTY' use 'cpp-options:
> -DDYNAMIC -DFRONTEND_VTY'
> setup: alex version >=2.0.1 && <3 is required but it could not be found.
> cabal: Error: some packages failed to install:
> yi-0.3 failed during the configure step. The exception was:
> exit: ExitFailure 1
> 
> Is this a cabal problem of package problem? I would have expected it
> to fail immediately instead of discover this problem so far into
> process.

So it's failing when configuring yi because alex is not installed.

So the question is when should this get checked? I think it's not
unreasonable to have the check where it is now though perhaps we could
do better by bringing it forward.

The point is, cabal-install only checks that haskell packages are
available before beginning to install stuff. It leaves all the other
checks (build tools, C libs, custom checks in Setup.hs script etc) to be
done at the configure phase of each package.

In theory it's not impossible to imagine doing the configure phase of
every package before doing the build phase of any package but it's not
clear that it gains us that much and it's a bit more complex to do it
that way.

Duncan

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


Re: [Haskell-cafe] Re: [Haskell] ANN: random-access-list-0.1

2008-06-13 Thread wren ng thornton

Isaac Dupree wrote:
"extractHead" is an ugly name for a nevertheless standardish-meaning 
function... what is it usually called? uncons? headTail? (Data.Sequence, 
which is meant to be left-right symmetric, calls it "viewr"... except 
your version doesn't have the Maybe, it's partial instead, fails on 
empty lists)



Views are nice, but these other functions are needed too. As for 
"extractHead", what about "split"? (cf. Control.Monad.Logic.msplit[1])


[1] http://tinyurl.com/37f4ga
http://hackage.haskell.org/packages/archive/logict/0.2.3/doc/html/Control-Monad-Logic-Class.html

--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Cabal-Install Fails To Compile

2008-06-13 Thread Aditya Siram

Thanks so much for your help. Actually Don got it fixed within twenty minutes 
but I mistakenly didn't cc the group. But it works perfectly now.

-Deech

> Subject: Re: [Haskell-cafe] Cabal-Install Fails To Compile
> From: [EMAIL PROTECTED]
> To: [EMAIL PROTECTED]
> CC: haskell-cafe@haskell.org
> Date: Fri, 13 Jun 2008 03:58:59 +0100
> 
> 
> On Thu, 2008-06-12 at 16:07 -0500, Aditya Siram wrote:
>> Hi all,
>> I downloaded cabal-install and the cabal-1.4 branch from darcs. The 
>> following error occurs when building:
>>> runhaskell Setup.hs build
>> 
>> Building cabal-install-0.4.9...
>> [19 of 27] Compiling Hackage.SrcDist  ( Hackage/SrcDist.hs, 
>> dist/build/cabal/cabal-tmp/Hackage/SrcDist.o )
>> 
>> Hackage/SrcDist.hs:58:59:
>> Couldn't match expected type `Char'
>>against inferred type 
>> `Distribution.Simple.PreProcess.PPSuffixHandler'
>>   Expected type: FilePath
>>   Inferred type: [Distribution.Simple.PreProcess.PPSuffixHandler]
>> In the fifth argument of `prepareSnapshotTree', namely
>> `knownSuffixHandlers'
>> In the second argument of `(>>=)', namely
>> `prepareSnapshotTree
>>verbosity pkg mb_lbi tmpDir knownSuffixHandlers'
> 
> Yeah, sorry that was my fault. You caught it in the few hours when the
> two darcs versions were not compatible. They work now, or as Don says,
> get the actual releases from hackage.
> 
> Duncan
> 

_
Search that pays you back! Introducing Live Search cashback.
http://search.live.com/cashback/?&pkw=form=MIJAAF/publ=HMTGL/crea=srchpaysyouback___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] working with Random.randoms

2008-06-13 Thread Daniel Fischer
Am Freitag, 13. Juni 2008 18:38 schrieb Stephen Howard:
> Hi List,
>
> I am a newcomer doing my obligatory struggling with Haskell's type
> system, and I've got a nut I've not been able to crack.  Given:
>
> import Random
>
> random_test :: Int -> String
> random_test n = do
> g <- getStdGen
> take n (randoms g)::String
>
> I'm expecting that I ought to be able to pass this action an integer and
> get back a random string that long (given, not all characters may be
> printable).
>
> But GHCI tells me:
>
> RandomTest.hs:7:4:
> Couldn't match `[]' against `IO'
>   Expected type: []
>   Inferred type: IO
> In a 'do' expression: g <- getStdGen
> In the definition of `random_test':
> random_test n = do
>   g <- getStdGen
> take n (randoms g) :: String
>
> And yet, when I run these lines in GHCI by hand, things seem to work
> (though the string is the same set of random characters each time,
> another bit that I need to solve):
>
> Prelude> :module Random
> Prelude Random> g <- getStdGen
> Prelude Random> take 5 (randoms g)::String
> "\1025049\315531\882767\1032009\334825"
>
>
> I'm guessing that randoms is returning an IO type but I'm not sure how

No, getStdGen is what's in IO, it has type IO StdGen. Since you can't get rid 
of IO safely, the type of random_test must be Int -> IO String.
Best practice is to separate into a pure part:

pure_random_test :: Int -> StdGen -> String
pure_random_test n g = take n (randoms g)

and the IO bound part:

random_test :: Int -> IO String
random_test n = do
g <- getStdGen
return $ pure_random_test n g

or, if we like it better:

random_test n = fmap (pure_random_test n) getStdGen

> to go about extracting the String to return to the calling action.
> Changing the type signature to Int -> IO  String only gives me a
> different error.
>
> Where am I going wrong?

You must put the String (take n (randoms g)) into the IO monad.

The way it works in ghci is due to the fact, that in ghci, you are basically 
in an IO loop/do-block.
When you type 
g <- getStdGen
the action is performed, and the result is bound to the identifier g.
When you then type
take 5 (randoms g),
it's transformed into
do .
let it = take 5 (randoms g)
print it
return it

Within one session, all calls to getStdGen return the same StdGen, that's why 
you always get the same sequence of random Chars.
>
> thanks,
> Stephen

HTH,
Daniel

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


[Haskell-cafe] working with Random.randoms

2008-06-13 Thread Stephen Howard

Hi List,

I am a newcomer doing my obligatory struggling with Haskell's type 
system, and I've got a nut I've not been able to crack.  Given:


import Random

random_test :: Int -> String
random_test n = do
   g <- getStdGen
   take n (randoms g)::String

I'm expecting that I ought to be able to pass this action an integer and 
get back a random string that long (given, not all characters may be 
printable).


But GHCI tells me:

RandomTest.hs:7:4:
   Couldn't match `[]' against `IO'
 Expected type: []
 Inferred type: IO
   In a 'do' expression: g <- getStdGen
   In the definition of `random_test':
   random_test n = do
 g <- getStdGen
   take n (randoms g) :: String

And yet, when I run these lines in GHCI by hand, things seem to work 
(though the string is the same set of random characters each time, 
another bit that I need to solve):


Prelude> :module Random
Prelude Random> g <- getStdGen
Prelude Random> take 5 (randoms g)::String
"\1025049\315531\882767\1032009\334825"


I'm guessing that randoms is returning an IO type but I'm not sure how 
to go about extracting the String to return to the calling action.  
Changing the type signature to Int -> IO  String only gives me a 
different error.


Where am I going wrong?

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


[Haskell-cafe] Re: [Haskell] ANN: random-access-list-0.1

2008-06-13 Thread Stephan Friedrichs

Isaac Dupree wrote:

[...]


Well Chris Okasaki called them "Skew Binary Random-Access Lists", 
which is even longer :)


:)

hmm.. IndexableList? (just a thought, not sure whether I like it any 
better)


RAList?
IList? <- (will I be sued by a large computer company for that?)


[...]
Yes, I wasn't happy with that one either. The view-concept of 
Data.Sequence is a good idea.

>
> yeah, it's a good idea, although I'm not sure how much I like the
> particular syntax of how it's done in Data.Sequence (the view-types'
> constructor names, mostly)

I now have

data View a
= Empty
| Cons a (RandomAccessList a)

and

view :: RandomAccessList a -> a

additionally, I renamed "extractHead" to "uncons" (which is OK, because 
I also have "cons") but still left "head" and "tail" with the typical 
list-like behaviour (causing an error on empty lists).



[Monad vs. Maybe]


That's quite convincing, most of all that "fail" has rather strange 
definitions for many Monads (because it originally does not belong to 
monads, does it?).



[...]


The size function is in O(1) because I cache it, otherwise it would be

size (RandomAccessList xs) = sum (map fst xs)

which is O(log n). I consider the caching useful, as most applications 
will check 0 <= i < size quite often.


sounds good

[...]

If two lists have exactly the same size, all the complete binary trees 
holding the data have the same size as well. This can be zipped 
directly and is a bit (~5% in my tests) faster.


okay, that sounds like a fair optimization, since zipping same-size 
lists is a nice thing to do anyway.  But the asymptotic speed ideally 
should still be O(min(m,n)), if possible?


Well... I guess that's possible converting the shorter one into a list 
and using fold for zipping. I'll have a close look at this!



--

Früher hieß es ja: Ich denke, also bin ich.
Heute weiß man: Es geht auch so.

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


[Haskell-cafe] cabal-install failure

2008-06-13 Thread Darrin Thompson
Cabal-install is looking good. It now, for the record, has only two
deps outside of Cabal-1.4.

I installed cabal-install-0.5 on ubuntu with the haskell.org linux
binary for ghc 6.8.2.

I then tried cabal-install yi

Got this output:
... many successful installs ...
Registering vty-3.0.1...
Reading package info from "dist/installed-pkg-config" ... done.
Saving old package config file... done.
Writing new package config file... done.
Downloading yi-0.3...
[1 of 1] Compiling Main ( Setup.hs, dist/setup/Main.o )

Setup.hs:9:0:
Warning: Deprecated use of `showPackageId'
 (imported from Distribution.Simple, but defined in
Distribution.Package):
 use the Text class instead
Linking dist/setup/setup ...
Warning: defaultUserHooks in Setup script is deprecated.
Configuring yi-0.3...
Warning: Instead of 'ghc-options: -DDYNAMIC -DFRONTEND_VTY' use 'cpp-options:
-DDYNAMIC -DFRONTEND_VTY'
setup: alex version >=2.0.1 && <3 is required but it could not be found.
cabal: Error: some packages failed to install:
yi-0.3 failed during the configure step. The exception was:
exit: ExitFailure 1

Is this a cabal problem of package problem? I would have expected it
to fail immediately instead of discover this problem so far into
process.

Thanks.

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


Re: [Haskell-cafe] Announce: Fortress talk in New York City

2008-06-13 Thread Jan-Willem Maessen


On Jun 13, 2008, at 10:43 AM, Bayley, Alistair wrote:


From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
Henning Thielemann


There will be a talk on Fortress...

---

This e-mail may contain confidential and/or privileged information.


You send potentially confidential information to a public
mailing list?


I realise this is tongue-in-cheek...



 Is this new language secret? :-)


.. but I'm not so sure about this. If this is a serious question, here
are some links:

 http://research.sun.com/projects/plrg/
 http://research.sun.com/projects/plrg/Publications/index.html
 http://projectfortress.sun.com/Projects/Community


Let me assure the readers there's nothing confidential or privileged  
about Christine's talk! :-)  It is, after all, an open source project.


-Jan-Willem Maessen
 Project Fortress, Sun Microsystems Laboratories
 [who will be off teaching Fortress in Prague at the time]

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


RE: [Haskell-cafe] Announce: Fortress talk in New York City

2008-06-13 Thread Bayley, Alistair
> From: [EMAIL PROTECTED] 
> [mailto:[EMAIL PROTECTED] On Behalf Of 
> Henning Thielemann
> 
> > There will be a talk on Fortress...
> >
> > ---
> >
> > This e-mail may contain confidential and/or privileged information.
> 
> You send potentially confidential information to a public 
> mailing list?

I realise this is tongue-in-cheek...


>   Is this new language secret? :-)

.. but I'm not so sure about this. If this is a serious question, here
are some links:

  http://research.sun.com/projects/plrg/
  http://research.sun.com/projects/plrg/Publications/index.html
  http://projectfortress.sun.com/Projects/Community

BTW, check out the crappy auto-appended disclaimer (over which I have no
control) on this message. Makes Jeff's look positively appealing.

Alistair
*
Confidentiality Note: The information contained in this message,
and any attachments, may contain confidential and/or privileged
material. It is intended solely for the person(s) or entity to
which it is addressed. Any review, retransmission, dissemination,
or taking of any action in reliance upon this information by
persons or entities other than the intended recipient(s) is
prohibited. If you received this in error, please contact the
sender and delete the material from any computer.
*

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


Re: Maybe-summary was: Re: [Haskell-cafe] Re: [Haskell] ANN:random-access-list-0.1

2008-06-13 Thread Claus Reinke

http://thread.gmane.org/gmane.comp.lang.haskell.libraries/9082
.. 
that Maybe is not the most general abstraction - it loses information 
wrt to (Either String), for instance:


Prelude> let {f [] = fail "empty"; f [_] = fail "singleton"; f l = 
return l }


okay, I see, it's just that most partial functions in Data.* / container 
libraries don't really have multiple failure modes that need 
distinguishing.  


Yes, I noticed that Ross was careful to note that in the message
that started that thread. I was more concerned with that specific
case being generalized to an argument against not-just-Maybe
(I think that was the title on the old wiki?).

And single failure mode in the components doesn't imply
single failure mode in combinations, either. Consider

   import Control.Monad
   import Control.Monad.Error

   f 1 = return 1
   f _ = fail "f"

   g 2 = return 2
   g _ = fail "g"

If I call 'f', and it fails, I know that it was 'f' that failed, and it
could only fail in a single way, so there's really no point in not
replacing 'fail "f"' with 'Nothing', right (and the same goes for
'g')? Wrong (or Left;-)! 

Combining functions with single failure modes gives combinations 
with multiple failure modes (think of different branches in a parser/
type system/.., or of different phases in a compiler). Compare the 
two outputs of 'test' below:


   forg n = f n `mplus` g n
   gorf n = g n `mplus` f n

   fandg n = f n >>= g
   gandf n = g n >>= f

   test = do
 print ([forg 3, gorf 3, fandg 1, fandg 2]::[Maybe Int])
 print ([forg 3, gorf 3, fandg 1, fandg 2]::[Either String Int])

I don't know whether that is an immediate concern for the
particular functions under discussion from the 'containers' 
package, apart from all the extra lifting (and re-adding of
sensible failure messages) when wanting to use those functions 
in a non-Maybe Monad? 

But it is a concern in general monadic programming (and it 
often requires extra work to ensure that failure paths combine 
as well as success paths).


Claus

PS: There was also the argument that there are cases where
local failure handling is just not sensible (what the Erlangers
call "don't program defensively", or "let it crash"), and 
where trying to return and handle those 'Nothing's would

only make the code less readable as the problem gets
passed from Pontius to Pilatus. The "let someone else
clean up" approach is also supported by the not-just-Maybe
pattern, although not as well in Haskell as in Erlang 
(with its supervisor trees and heart-beat monitoring).



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


Re: [Haskell-cafe] [WARN] Bug fix release of pureMD5 (Was: pureMD5)

2008-06-13 Thread Uwe Schmidt
Thomas M. DuBuisson wrote:

> As you can probably tell, I didn't invest enough into the
> non-performance aspects of pureMD5.  Faced with actual users ;-), I have
> released version 0.2.0 which has the bug fix, a new API (type prevention
> from re-finalizing a digest), and a reasonable set of quickchecks
> (covering Show / Binary instances, known answer and incremented
> hashing).  Oh, also the module name has changed to place it inline with
> 'Crypto' package naming while not colliding.

there is a small bug in pureMD5.cabal

the line
  hs-source-dirs: Data,Test

should be
  hs-source-dirs:   .

otherwise the sources are not found (at least on my linux box)

Cheers,

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


Re: [Haskell-cafe] Announce: Fortress talk in New York City

2008-06-13 Thread Henning Thielemann


On Fri, 13 Jun 2008, Jeff Polakow wrote:


Hello,

There will be a talk on Fortress ( a new OO/Functional language from Sun)
on Wednesday June 25 at 6:30pm in Manhattan.

Abstract:

The Java Programming Language revolutionized programming with two simple
concepts:   "Write once run anywhere", and Garbage Collection.  This led
to a big step up in programmer productivity.  Project Fortress does it
again.This time we give you multiprocessor performance without
having to code threads, locks, or load balancing.  Can you say "Implicit
Parallelism" and "Transactional Memory"?  We also give you a growable
language (small fixed core), strong static typing (more errors caught at
compile time), and mathematical notation.   This talk will focus on the
strengths of Fortress as a programming language, as well as a deep dive
into implementation issues.

More information is available at http://lisp.meetup.com/59

-Jeff


---

This e-mail may contain confidential and/or privileged information.


You send potentially confidential information to a public mailing list?
 Is this new language secret? :-)

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


Re: [Haskell-cafe] Announce: Fortress talk in New York City

2008-06-13 Thread Darrin Thompson
2008/6/13 Jeff Polakow <[EMAIL PROTECTED]>:
> There will be a talk on Fortress ( a new OO/Functional language from Sun) on
> Wednesday June 25 at 6:30pm in Manhattan.
>

Sounds interesting. Any plans to post video?

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


[Haskell-cafe] Announce: Fortress talk in New York City

2008-06-13 Thread Jeff Polakow
Hello,

There will be a talk on Fortress ( a new OO/Functional language from Sun) 
on Wednesday June 25 at 6:30pm in Manhattan. 

Abstract:

The Java Programming Language revolutionized programming with two simple 
concepts:   "Write once run anywhere", and Garbage Collection.  This led 
to a big step up in programmer productivity.  Project Fortress does it 
again.This time we give you multiprocessor performance without 
having to code threads, locks, or load balancing.  Can you say "Implicit 
Parallelism" and "Transactional Memory"?  We also give you a growable 
language (small fixed core), strong static typing (more errors caught at 
compile time), and mathematical notation.   This talk will focus on the 
strengths of Fortress as a programming language, as well as a deep dive 
into implementation issues.

More information is available at http://lisp.meetup.com/59

-Jeff


---

This e-mail may contain confidential and/or privileged information. If you 
are not the intended recipient (or have received this e-mail in error) 
please notify the sender immediately and destroy this e-mail. Any 
unauthorized copying, disclosure or distribution of the material in this 
e-mail is strictly forbidden.___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] cgi liftM liftIO

2008-06-13 Thread Cetin Sert
Hi,

Could someone please care to explain what I am doing wrong below in cgiMain2
and how can I fix it?


./Main.hs:25:15:
No instance for (MonadCGI IO)
  arising from a use of `output' at ./Main.hs:25:15-20
Possible fix: add an instance declaration for (MonadCGI IO)
In the first argument of `($)', namely `output'
In the expression: output $ renderHtml $ page "import" fileForm
In the definition of `upload':
upload = output $ renderHtml $ page "import" fileForm

./Main.hs:57:29:
Couldn't match expected type `CGI CGIResult'
   against inferred type `IO CGIResult'
In the first argument of `handleErrors', namely `cgiMain2'
In the second argument of `($)', namely `handleErrors cgiMain2'
In the expression: runCGI $ handleErrors cgiMain2


import IO
import Network.CGI
import Text.XHtml

import qualified Data.ByteString.Lazy as BS

import Control.Monad (liftM)
import Data.Maybe (fromJust)

import Interact

fileForm = form ! [method "post", enctype "multipart/form-data"] <<
 [afile "file", submit "" "Upload"]

page t b = header << thetitle << t +++ body << b

cgiMain1 = do
  getInputFPS "file" ↠ λms → maybe upload contents ms ↠ return
  where
upload   = output $ renderHtml $ page "import" fileForm
contents = outputFPS

cgiMain2 = do
  getInputFPS "file" ↠ λms → maybe upload contents ms ↠ return
  where
upload   = output $ renderHtml $ page "import" fileForm
contents = λs → do
  (i,o,h,_) ← runUnzip
  BS.hPutStr i s
  c ← BS.hGetContents o
  outputFPS c


{-
  (i,o,h,_) ← runUnzip
  BS.hPutStr i s
  BS.hGetContents o ↠ outputFPS
-}



{-
liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r
liftIO :: (MonadIO m) => IO a -> m a

saveFile n =
do cont <- liftM fromJust $ getInputFPS "file"
   let f = uploadDir ++ "/" ++ basename n
   liftIO $ BS.writeFile f cont
   return $ paragraph << ("Saved as " +++ anchor ! [href f] << f +++
".")
-}

runUnzip = runInteractiveCommand "unzip -l /dev/stdin"

main = runCGI $ handleErrors cgiMain2

Best Regards,
Cetin Sert

P/s: what are lifts o_O?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] ANN: random-access-list-0.1

2008-06-13 Thread Jules Bean
Whether fail should be in Monad, or whether we really want MonadZero, 
MonadPlus, MonadError, or something else entirely has been open for 
discussion, but it is easily shown
that Maybe is not the most general abstraction - it loses information 
wrt to (Either String), for instance:


Prelude> let {f [] = fail "empty"; f [_] = fail "singleton"; f l = 


Yes. But that's not what we're talking about.

We're talking about lookup and index which both have one and exactly one 
failure mode : not found.


For these functions, Maybe a is both the most general and the most 
precise type.


It is trivial to upgrade Maybe a by decorating it with an error should 
you choose to do so:


maybe (throwError "better error message here") return

which I sometimes define as 'withError' or similar.

d <- M.lookup "foo" `withError` "Variable foo not in symbol table"

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


Re: [Haskell-cafe] Difficulty installing hscurses

2008-06-13 Thread Duncan Coutts

On Fri, 2008-06-13 at 05:15 -0400, Dominic Espinosa wrote:
> Hello,
> 
> I'm trying to install hscurses on debian-testing. I have ghc6 installed,
> which I've written some toy programs with, but I haven't tried to
> install any Hackage packages until now.
> 
> hscurses depends on old-time and old-locale (those names make me raise
> my eyebrows a bit). In turn, old-time seems to depend on old-locale. So,
> I tried installing old-locale first. In installed fine. Now I'm trying
> to install old-time:

I think you must be using ghc-6.6.x in which case you do not need
old-time and indeed you cannot install it. The modules in old-time were
included in the base package in ghc-6.6.x and split out into the
old-time package in ghc-6.8.x.

So the problem is that hscurses is not buildable out-of-the-box with
ghc-6.6.x. You can probably hack it by editing the hscurses.cabal file
and removing old-locale and old-time from the build-depends field.

On the hackage page for hscurses
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hscurses

it says:
Built on ghc-6.8

what this doesn't say clearly is that this means it did not build on
ghc-6.6.

Duncan

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


Maybe-summary was: Re: [Haskell-cafe] Re: [Haskell] ANN: random-access-list-0.1

2008-06-13 Thread Isaac Dupree

Claus Reinke wrote:
To summarize: Monad isn't the proper abstraction for failable/Maybe. 
Maybe is an algebraic data type that *exactly* represents the spirit 
of what you're trying to do: e.g. Conor McBride said: "Maybe is the 
most general abstraction. Requiring (>>=), or even (<*>) seems 
excessive. What we need is "any f with zero and return", so why not 
pick the canonical, initial, inductively defined such thing?"  In this 
case the typeclass adds no generality to the function's behaviour 
(Maybe can be trivially converted to any other type, with a combinator 
even).  And the confusion that results, when the function is almost 
always used at type Maybe anyway.  If you want to read the whole 
discussion... if you haven't been subscribed to [EMAIL PROTECTED] 
, it's archived:

http://thread.gmane.org/gmane.comp.lang.haskell.libraries/9082


Thanks for the summary. I had been wondering about this
change of mood, and I disagree with the suggestion that
Maybe Nothing is the right replacement for Monad fail.
Whether fail should be in Monad, or whether we really want MonadZero, 
MonadPlus, MonadError, or something else entirely has been open for 
discussion, but it is easily shown
that Maybe is not the most general abstraction - it loses information 
wrt to (Either String), for instance:


Prelude> let {f [] = fail "empty"; f [_] = fail "singleton"; f l = 
return l }


okay, I see, it's just that most partial functions in Data.* / container 
libraries don't really have multiple failure modes that need 
distinguishing.  You could say, in a type/information-theoretic mindset, 
that even your "f [_]" above loses information because it doesn't vary 
based on the _ (and so it isn't reversible) (and this is very common and 
normal especially for error messages, but there's a large design space 
for places where they're needed, depending on whether a machine needs to 
understand the message, etc.)  I think we didn't conclude much about 
e.g. parser-library return types, because we (thankfully) weren't trying to.


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


Re: [Haskell-cafe] Re: [Haskell] ANN: random-access-list-0.1

2008-06-13 Thread Claus Reinke
To summarize: Monad isn't the proper abstraction for failable/Maybe. 
Maybe is an algebraic data type that *exactly* represents the spirit of 
what you're trying to do: e.g. Conor McBride said: "Maybe is the most 
general abstraction. Requiring (>>=), or even (<*>) seems excessive. 
What we need is "any f with zero and return", so why not pick the 
canonical, initial, inductively defined such thing?"  In this case the 
typeclass adds no generality to the function's behaviour (Maybe can be 
trivially converted to any other type, with a combinator even).  And the 
confusion that results, when the function is almost always used at type 
Maybe anyway.  If you want to read the whole discussion... if you 
haven't been subscribed to [EMAIL PROTECTED] , it's archived:

http://thread.gmane.org/gmane.comp.lang.haskell.libraries/9082


Thanks for the summary. I had been wondering about this
change of mood, and I disagree with the suggestion that
Maybe Nothing is the right replacement for Monad fail. 

Whether fail should be in Monad, or whether we really want 
MonadZero, MonadPlus, MonadError, or something else 
entirely has been open for discussion, but it is easily shown
that Maybe is not the most general abstraction - it loses 
information wrt to (Either String), for instance:


Prelude> let {f [] = fail "empty"; f [_] = fail "singleton"; f l = return l }
Prelude> f [] :: Maybe [Bool]
Nothing
Prelude> f [True] :: Maybe [Bool]
Nothing
Prelude> f [True,False] :: Maybe [Bool]
Just [True,False]
Prelude>
Prelude> :m +Control.Monad.Error
Prelude Control.Monad.Error> f [] :: Either String [Bool]
Left "empty"
Prelude Control.Monad.Error> f [True] :: Either String [Bool]
Left "singleton"
Prelude Control.Monad.Error> f [True,False] :: Either String [Bool]
Right [True,False]

You can specialise Monad to Maybe, but you can't get
back to the general handling of failure without losing the
failure messages!

Choosing Maybe over (Either String) means: "I don't care
about the failure messages" (not that String is necessarily the
best way to represent failure conditions, but that is another
story again). As anyone who has ever tried to use a Parser
based on that choice can attest, that choice should not be
taken lightly ("Compilation failed. There were errors.").

Claus


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


[Haskell-cafe] Re: [Haskell] ANN: random-access-list-0.1

2008-06-13 Thread Isaac Dupree

Stephan Friedrichs wrote:

Isaac Dupree wrote:

[...]

Great to see it, it deserved implementing, IIRC!  I don't remember 
enough about it.. (and don't have Okasaki anywhere handy). Can it be 
lazy or infinitely long?


No, it has to be finite as it's actually a list of complete binary trees 
whose size depend on the skew binary representation of the list's size. 
I'll document this.


okay then


[...]

Is "RandomAccessList" the best name for something that's not O(1), 
just O(log n)?  Or just that "RandomAccessList" is just much longer 
than "[]"?


Well Chris Okasaki called them "Skew Binary Random-Access Lists", which 
is even longer :)


:)

hmm.. IndexableList? (just a thought, not sure whether I like it any better)



don't use those unorthodox infix function names.. `cons` is hardly 
worse than .:. , `append` or `mappend` than .+. , and .!. than, hmm.. 
. Export a ++ and ! (!! ?) if you're really dedicated. But I'd prefer 
an `at` that's the same partial indexing operation, rather than the 
name .!. (I think this "at" was a new name being put somewhere else? 
partly because "!" is trying to be gradually used only to refer to 
strictness?)


Good point!



"extractHead" is an ugly name for a nevertheless standardish-meaning 
function... what is it usually called? uncons? headTail? 
(Data.Sequence, which is meant to be left-right symmetric, calls it 
"viewr"... except your version doesn't have the Maybe, it's partial 
instead, fails on empty lists)


Yes, I wasn't happy with that one either. The view-concept of 
Data.Sequence is a good idea.


yeah, it's a good idea, although I'm not sure how much I like the 
particular syntax of how it's done in Data.Sequence (the view-types' 
constructor names, mostly)




For "index", don't use Monad, use Maybe (I think that's what the 
recent [EMAIL PROTECTED] discussion concluded, in the context of 
switching Data.Map back to Maybe).


I was just copying the idea from Data.Map and it's usually a good thing 
to have functions as general as possible, or why is it not?


To summarize: Monad isn't the proper abstraction for failable/Maybe. 
Maybe is an algebraic data type that *exactly* represents the spirit of 
what you're trying to do: e.g. Conor McBride said: "Maybe is the most 
general abstraction. Requiring (>>=), or even (<*>) seems excessive. 
What we need is "any f with zero and return", so why not pick the 
canonical, initial, inductively defined such thing?"  In this case the 
typeclass adds no generality to the function's behaviour (Maybe can be 
trivially converted to any other type, with a combinator even).  And the 
confusion that results, when the function is almost always used at type 
Maybe anyway.  If you want to read the whole discussion... if you 
haven't been subscribed to [EMAIL PROTECTED] , it's archived:

http://thread.gmane.org/gmane.comp.lang.haskell.libraries/9082

Also, Data.List has genericLength etc, to 


At the moment, I'm using the Int type for size and indexing only for one 
reason: I haven't found a proper way to generalize it. I'd really like 
to use the Ix class, but it doesn't provide enough functionality, it 
only works on fixed-size intervals (i. e. for arrays, which don't change 
their size, but a list does). Maybe someone has an idea of how to 
realize lists with a variable starting index and size?


fair enough.  If your implementation only supports sizes up to that of 
Int (which is reasonable for a strict finite type... whereas something 
like ([1..2^34] `genericIndex` (2^33)) can probably complete in a small 
amount of memory and only a moderate amount of time on a modern machine, 
even a 32-bit one, due to laziness and garbage collection)


support.  Isn't "index" (like Data.List.genericIndex) supposed to be a 
name for a partial operation, not one that returns a Maybe?  Shouldn't 
"size" be named "length" (or exported as both names, since e.g. 
Data.Map.size, .List.length) (why is it O(1) not O(log n)? Is it 
possible for these RandomAccessLists to be longer than maxBound::Int?)?


The size function is in O(1) because I cache it, otherwise it would be

size (RandomAccessList xs) = sum (map fst xs)

which is O(log n). I consider the caching useful, as most applications 
will check 0 <= i < size quite often.


sounds good





for e.g. toList, is the O(n) cost spread over traversing/demanding the 
items of the generated list, or all up-front, or somewhere in between?


Why is zip slow with unbalanced lists?  Obviously, it could be 
implemented O(min(m,n)*(log m + log n)) just indexing each one, which 
would be faster for really unbalanced-size lists...  Obviously, I don't 


If two lists have exactly the same size, all the complete binary trees 
holding the data have the same size as well. This can be zipped directly 
and is a bit (~5% in my tests) faster.


okay, that sounds like a fair optimization, since zipping same-size 
lists is a nice thing to do anyway.  But the asymptotic speed ideally 
should still be O(min(m,

[Haskell-cafe] Difficulty installing hscurses

2008-06-13 Thread Dominic Espinosa
Hello,

I'm trying to install hscurses on debian-testing. I have ghc6 installed,
which I've written some toy programs with, but I haven't tried to
install any Hackage packages until now.

hscurses depends on old-time and old-locale (those names make me raise
my eyebrows a bit). In turn, old-time seems to depend on old-locale. So,
I tried installing old-locale first. In installed fine. Now I'm trying
to install old-time:

$ runhaskell Setup.hs configure
Warning: defaultUserHooks in Setup script is deprecated.
Configuring old-time-1.0.0.0...
Warning: The 'build-type' is 'Configure' but there is no 'configure' script.

(given these warnings, I don't really expect the next command to
succeed, but what the hell:)

$ runhaskell Setup.hs build

Preprocessing library old-time-1.0.0.0...
Building old-time-1.0.0.0...

System/Time.hsc:118:7:
Could not find module `System.Locale':
  it was found in multiple packages: old-locale-1.0.0.0 base

No idea what to do here. Is old-time conflicting with whatever "time"
package superseded it, or what?

I'm new to Haskell, and understanding the guts of its packaging system
is a bit beyond me right now. Sorry if this is a FAQ or something, but I
tried some Google searches and found nothing useful.

Any help or tips appreciated.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe