Re: problems figuring out what the type system is telling me

2002-06-07 Thread Chris Moline

On Fri, Jun 07, 2002 at 09:54:16PM -0700, Hal Daume III wrote:
> see http://haskell.org/wiki/wiki?ThatAnnoyingIoType and
> http://haskell.org/wiki/wiki?UsingIo

my apologies. please assume that i am really stupid. i have already read those 
two. i have also read what the hell are monads and monads for the working 
haskell programmer. i still do not get what i am doing wrong.

getDepends :: String -> [String]
getDepends p = do
handle <- openFile (portsDir ++ p ++ "/+CONTENTS") ReadMode
fetchDepends handle

to my brain this takes a string, concatenates it with portsDir and 
"+/CONTENTS", and passes it to openfile. openFile then returns a handle and 
this handle and passes it to fetchDepends. getDepends will return whatever 
fetchDepends returns, assuming openFile succeeds. however ghc says

Phoebe.hs:19:
Couldn't match `[]' against `IO'
Expected type: [t]
Inferred type: IO Handle
In the application `openFile (portsDir ++ (p ++ "/+CONTENTS"))
 ReadMode'
In a 'do' expression pattern binding:
handle <- openFile (portsDir ++ (p ++ "/+CONTENTS")) ReadMode

i do not know what this [t] is and i do not know why it is expected. my theory 
is it is being caused by something in fetchDepends.

fetchDepends :: Handle -> [String]
fetchDepends handle = do
l <- hGetLine handle
e <- hIsEOF handle
case (not e) of
True ->
case (matchRegex (mkRegex "^@pkgdep") l) of
Just [a] -> [drop 8 l] ++ (fetchDepends handle)
_ -> fetchDepends handle
False -> []

here ghc reports

Phoebe.hs:24:
Couldn't match `[]' against `IO'
Expected type: [t]
Inferred type: IO String
In the application `hGetLine handle'
In a 'do' expression pattern binding: l <- hGetLine handle

i am thinking that this has something to do with l. but i cant think of 
anything beyond that.

here a couple of other attempts to show that i am trying and that i have no 
clue what i am doing.

-- put a return around everything that might need it
getDepends :: String -> [String]
getDepends p = do
handle <- openFile (portsDir ++ p ++ "/+CONTENTS") ReadMode
return (fetchDepends handle)

fetchDepends :: Handle -> [String]
fetchDepends handle = do
l <- hGetLine handle
e <- hIsEOF handle
case (not e) of
True ->
case (matchRegex (mkRegex "^@pkgdep") l) of
Just _ -> return ([drop 8 l] ++
(fetchDepends handle))
_ -> return (fetchDepends handle)
False -> return []

-- try making l into a string by show'ing it
getDepends :: String -> [String]
getDepends p = do
handle <- openFile (portsDir ++ p ++ "/+CONTENTS") ReadMode
fetchDepends handle

fetchDepends :: Handle -> [String]
fetchDepends handle = do
l <- hGetLine handle
e <- hIsEOF handle
case (not e) of
True ->
case (matchRegex (mkRegex "^@pkgdep") (show l)) of
Just _ -> [drop 8 (show l)] ++ (fetchDepends handle)
_ -> fetchDepends handle
False -> []

-- try removing the type declarations
getDepends p = do
handle <- openFile (portsDir ++ p ++ "/+CONTENTS") ReadMode
fetchDepends handle

fetchDepends handle = do
l <- hGetLine handle
e <- hIsEOF handle
case (not e) of
True ->
case (matchRegex (mkRegex "^@pkgdep") l) of
Just _ -> [drop 8 l] ++ (fetchDepends handle)
 _ -> fetchDepends handle
False -> []

Phoebe.hs:27:
Couldn't match `[[Char]]' against `IO [[Char]]'
Expected type: [[Char]]
Inferred type: IO [[Char]]
In the application `fetchDepends handle'
In the second argument of `(++)', namely `(fetchDepends handle)'
Failed, modules loaded: none.

ok. a different error message. it still makes no sense. i will try a couple 
more times before i finish this message.

-- try show'ing (fetchDepends handle)
getDepends p = do
handle <- openFile (portsDir ++ p ++ "/+CONTENTS") ReadMode
fetchDepends handle

fetchDepends handle = do
l <- hGetLine handle
e <- hIsEOF handle
case (not e) of
True ->
case (matchRegex (mkRegex "^@pkgdep") l) of
Just _ -> [drop 8 l] ++
(show (fetchDepends handle))
_ -> fetchDepends handle
False -> []

error message is

Phoebe.hs:27:
Couldn't match `IO' against `[]'
Expected type: IO t
Inferred type: [a]
In the appli

Re: problems figuring out what the type system is telling me

2002-06-07 Thread Hal Daume III

see http://haskell.org/wiki/wiki?ThatAnnoyingIoType and
http://haskell.org/wiki/wiki?UsingIo

--
Hal Daume III

 "Computer science is no more about computers| [EMAIL PROTECTED]
  than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume

On Fri, 7 Jun 2002, Chris Moline wrote:

> hi. i am really stuck on this problem and i cant seem to figure it out and so 
> i am posting this in the hopes someone will help me. i realize you prolly get 
> this kind of question alot but the wiki and the papers i have been reading 
> arent helping to clarify things.
> 
> i am trying to write a little utility to make it easier to get rid of ports on 
> my machine. the function that is giving me trouble is getDepends. it takes the 
> name of a port and opens the appropriate +CONTENTS file and returns the 
> dependencies it finds.
> 
> here is the function and its helper.
> 
> getDepends :: String -> [String]
> getDepends p = do
> handle <- openFile (portsDir ++ p) ReadMode
> fetchDepends handle
> 
> fetchDepends :: Handle -> [String]
> fetchDepends handle = do
> l <- hGetLine handle
> e <- hIsEOF handle
> case (not e) of   -- ifs keep giving indent errors so ill just use case
> True ->
> case (matchRegex (mkRegex "^@pkgdep") l) of
> Just [a] -> [drop 8 l] ++ (fetchDepends handle)
> _ -> fetchDepends handle
> False -> ""
> 
> here is ghci's error messages.
> 
> Compiling Pheobe   ( Phoebe.hs, interpreted )
> 
> Phoebe.hs:19:
> Couldn't match `[]' against `IO'
> Expected type: [t]
> Inferred type: IO Handle
> In the application `openFile (portsDir ++ p) ReadMode'
> In a 'do' expression pattern binding:
> handle <- openFile (portsDir ++ p) ReadMode
> 
> Phoebe.hs:24:
> Couldn't match `[]' against `IO'
> Expected type: [t]
> Inferred type: IO String
> In the application `hGetLine handle'
> In a 'do' expression pattern binding: l <- hGetLine handle
> Failed, modules loaded: none.
> 
> could someone be so kind as to explain what the problem is?
> 
> sincerly,
> chris moline
> ___
> Haskell-Cafe mailing list
> [EMAIL PROTECTED]
> http://www.haskell.org/mailman/listinfo/haskell-cafe
> 

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



problems figuring out what the type system is telling me

2002-06-07 Thread Chris Moline

hi. i am really stuck on this problem and i cant seem to figure it out and so 
i am posting this in the hopes someone will help me. i realize you prolly get 
this kind of question alot but the wiki and the papers i have been reading 
arent helping to clarify things.

i am trying to write a little utility to make it easier to get rid of ports on 
my machine. the function that is giving me trouble is getDepends. it takes the 
name of a port and opens the appropriate +CONTENTS file and returns the 
dependencies it finds.

here is the function and its helper.

getDepends :: String -> [String]
getDepends p = do
handle <- openFile (portsDir ++ p) ReadMode
fetchDepends handle

fetchDepends :: Handle -> [String]
fetchDepends handle = do
l <- hGetLine handle
e <- hIsEOF handle
case (not e) of -- ifs keep giving indent errors so ill just use case
True ->
case (matchRegex (mkRegex "^@pkgdep") l) of
Just [a] -> [drop 8 l] ++ (fetchDepends handle)
_ -> fetchDepends handle
False -> ""

here is ghci's error messages.

Compiling Pheobe   ( Phoebe.hs, interpreted )

Phoebe.hs:19:
Couldn't match `[]' against `IO'
Expected type: [t]
Inferred type: IO Handle
In the application `openFile (portsDir ++ p) ReadMode'
In a 'do' expression pattern binding:
handle <- openFile (portsDir ++ p) ReadMode

Phoebe.hs:24:
Couldn't match `[]' against `IO'
Expected type: [t]
Inferred type: IO String
In the application `hGetLine handle'
In a 'do' expression pattern binding: l <- hGetLine handle
Failed, modules loaded: none.

could someone be so kind as to explain what the problem is?

sincerly,
chris moline
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe