GHC not buying what I am offering this afternoon

My main function looks like this: main :: [IO()] main = do let stud1 = Student {name = "Geoff", average = -99.0, grades = [66,77,88]} let stud2 = Student {name = "Doug", average = -99.0, grades = [77,88,99]} let stud3 = Student {name = "Ron", average = -99.0, grades = [55,66,77]} let studList = [stud1,stud2] let newList = calcAvg studList [putStrLn $ show s | s <- newList] --putStrLn $ show (newList !! 0) --putStrLn $ show (newList !! 1) With this final line, putStrLn $ show (newList !! 0), the type IO () in the function declaration compiles fine. But with [putStrLn $ show s | s <- newList] as the final line, [IO ()] in the function declaration will not compile, I get this error: Couldn't match expected type `IO t0' with actual type `[IO ()]' What does the declared type need to be for a final line of: [putStrLn $ show s | s <- newList] ??? Thanks, Geoffrey

main must have type IO a. Hoogle tells me that to convert [IO a] -> IO [a],
you should use the function sequence. Try applying that to your final line.
On Mon, 9 Mar 2015 16:07 Geoffrey Bays
My main function looks like this:
main :: [IO()] main = do let stud1 = Student {name = "Geoff", average = -99.0, grades = [66,77,88]} let stud2 = Student {name = "Doug", average = -99.0, grades = [77,88,99]} let stud3 = Student {name = "Ron", average = -99.0, grades = [55,66,77]} let studList = [stud1,stud2] let newList = calcAvg studList [putStrLn $ show s | s <- newList] --putStrLn $ show (newList !! 0) --putStrLn $ show (newList !! 1)
With this final line, putStrLn $ show (newList !! 0), the type IO () in the function declaration compiles fine. But with [putStrLn $ show s | s <- newList] as the final line, [IO ()] in the function declaration will not compile, I get this error:
Couldn't match expected type `IO t0' with actual type `[IO ()]'
What does the declared type need to be for a final line of: [putStrLn $ show s | s <- newList] ???
Thanks,
Geoffrey
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

Thanks, Joel.
Putting the type IO [()] in the main declaration and this as the final line
of the main function does do the trick:
sequence [putStrLn $ show s | s <- newList]
But this is the kind of thing that makes Haskell types difficult for
beginners to work with...
Geoffrey
On Mon, Mar 9, 2015 at 4:15 PM, Joel Williamson wrote: main must have type IO a. Hoogle tells me that to convert [IO a] -> IO
[a], you should use the function sequence. Try applying that to your final
line. On Mon, 9 Mar 2015 16:07 Geoffrey Bays My main function looks like this: main :: [IO()]
main = do
let stud1 = Student {name = "Geoff", average = -99.0, grades =
[66,77,88]}
let stud2 = Student {name = "Doug", average = -99.0, grades =
[77,88,99]}
let stud3 = Student {name = "Ron", average = -99.0, grades =
[55,66,77]}
let studList = [stud1,stud2]
let newList = calcAvg studList
[putStrLn $ show s | s <- newList]
--putStrLn $ show (newList !! 0)
--putStrLn $ show (newList !! 1) With this final line, putStrLn $ show (newList !! 0), the type IO () in
the function declaration compiles fine.
But with [putStrLn $ show s | s <- newList] as the final line, [IO ()] in
the function declaration will not compile, I get this error: Couldn't match expected type `IO t0' with actual type `[IO ()]' What does the declared type need to be for a final line of:
[putStrLn $ show s | s <- newList] ??? Thanks, Geoffrey _______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners _______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

There is a difference between IO [()] and IO () and [IO ()]
A type of [IO ()] is a list of actions, none of which have actually been
executed.
A type of IO [()] is a single action that has executed and returned a bunch
of nils.
sequence is one way to combine a list of actions into a single action that
returns a list of their results, but it might be better to try and separate
the pure and impure part of that line of code:
mapM putStrLn $ ([show s | s <- [1,2,3]] :: [String]) :: IO [()]
The type annotations are for explanation only. Then use mapM_ if you do
not want to save these nils for some reason (there are performance
implications).
On Mon, Mar 9, 2015 at 4:25 PM, Geoffrey Bays
Thanks, Joel.
Putting the type IO [()] in the main declaration and this as the final line of the main function does do the trick:
sequence [putStrLn $ show s | s <- newList]
But this is the kind of thing that makes Haskell types difficult for beginners to work with...
Geoffrey
On Mon, Mar 9, 2015 at 4:15 PM, Joel Williamson < joel.s.williamson@gmail.com> wrote:
main must have type IO a. Hoogle tells me that to convert [IO a] -> IO [a], you should use the function sequence. Try applying that to your final line.
On Mon, 9 Mar 2015 16:07 Geoffrey Bays
wrote: My main function looks like this:
main :: [IO()] main = do let stud1 = Student {name = "Geoff", average = -99.0, grades = [66,77,88]} let stud2 = Student {name = "Doug", average = -99.0, grades = [77,88,99]} let stud3 = Student {name = "Ron", average = -99.0, grades = [55,66,77]} let studList = [stud1,stud2] let newList = calcAvg studList [putStrLn $ show s | s <- newList] --putStrLn $ show (newList !! 0) --putStrLn $ show (newList !! 1)
With this final line, putStrLn $ show (newList !! 0), the type IO () in the function declaration compiles fine. But with [putStrLn $ show s | s <- newList] as the final line, [IO ()] in the function declaration will not compile, I get this error:
Couldn't match expected type `IO t0' with actual type `[IO ()]'
What does the declared type need to be for a final line of: [putStrLn $ show s | s <- newList] ???
Thanks,
Geoffrey
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

sequence will get the types to match up, but a more elegant solution
would be to get every line into a single string, then print that.
putStrLn $ unlines $ map show newList
I agree that getting the types to line up can be a nuisance, and with
such small programs it doesn't bring much of an advantage. Ultimately,
if you want side-effects to be reflected in the type system, there
will be times you have to do a bit of extra work to satisfy the type
checker. Learning to write well-typed code is much easier in this
context, where everything has a fairly concrete type and there is lots
of documentation, than having to learn it later when you have weird
types coming from 3 different libraries and are facing a problem no
one else has had. I would recommend getting very comfortable with GHCi
and Hoogle.
If you haven't already, add a hoogle prompt to GHCi by pasting something like
:def hoogle \str -> return $ ":! hoogle --count=15 \"" ++ str ++ "\""
in your ghci.conf. This will allow you to easily search for functions
of a given type. Typing
:hoogle [IO a] -> IO [a]
returned all the information needed to answer your question.
On Mon, Mar 9, 2015 at 4:25 PM, Geoffrey Bays
Thanks, Joel.
Putting the type IO [()] in the main declaration and this as the final line of the main function does do the trick:
sequence [putStrLn $ show s | s <- newList]
But this is the kind of thing that makes Haskell types difficult for beginners to work with...
Geoffrey
On Mon, Mar 9, 2015 at 4:15 PM, Joel Williamson
wrote: main must have type IO a. Hoogle tells me that to convert [IO a] -> IO [a], you should use the function sequence. Try applying that to your final line.
On Mon, 9 Mar 2015 16:07 Geoffrey Bays
wrote: My main function looks like this:
main :: [IO()] main = do let stud1 = Student {name = "Geoff", average = -99.0, grades = [66,77,88]} let stud2 = Student {name = "Doug", average = -99.0, grades = [77,88,99]} let stud3 = Student {name = "Ron", average = -99.0, grades = [55,66,77]} let studList = [stud1,stud2] let newList = calcAvg studList [putStrLn $ show s | s <- newList] --putStrLn $ show (newList !! 0) --putStrLn $ show (newList !! 1)
With this final line, putStrLn $ show (newList !! 0), the type IO () in the function declaration compiles fine. But with [putStrLn $ show s | s <- newList] as the final line, [IO ()] in the function declaration will not compile, I get this error:
Couldn't match expected type `IO t0' with actual type `[IO ()]'
What does the declared type need to be for a final line of: [putStrLn $ show s | s <- newList] ???
Thanks,
Geoffrey
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

Just like sequence, there is also a function sequence_ that you might want
to use.
sequence_ :: Monad m => [m a] -> m () -- for m = IO, sequence_ ::
[IO a] -> IO ()
sequence_ lst = do
sequence lst
return ()
-- also, mapM and mapM_ are useful too
mapM f = sequence . map f -- retains results
mapM_ f = sequence_ . map f -- ignores results
-- Some use cases
ghci> sequence [print 2, print 3]
2
3
[(),()] -- The results, each print is of type IO (), i.e does IO
and produces ()
ghci> mapM print [2,3] -- same as above
ghci> mapM_ print [2,3] -- same as above, but without results (or
result of type unit, i.e ())
On 10 March 2015 at 02:09, Joel Williamson
sequence will get the types to match up, but a more elegant solution would be to get every line into a single string, then print that.
putStrLn $ unlines $ map show newList
I agree that getting the types to line up can be a nuisance, and with such small programs it doesn't bring much of an advantage. Ultimately, if you want side-effects to be reflected in the type system, there will be times you have to do a bit of extra work to satisfy the type checker. Learning to write well-typed code is much easier in this context, where everything has a fairly concrete type and there is lots of documentation, than having to learn it later when you have weird types coming from 3 different libraries and are facing a problem no one else has had. I would recommend getting very comfortable with GHCi and Hoogle.
If you haven't already, add a hoogle prompt to GHCi by pasting something like :def hoogle \str -> return $ ":! hoogle --count=15 \"" ++ str ++ "\"" in your ghci.conf. This will allow you to easily search for functions of a given type. Typing :hoogle [IO a] -> IO [a] returned all the information needed to answer your question.
Thanks, Joel.
Putting the type IO [()] in the main declaration and this as the final
On Mon, Mar 9, 2015 at 4:25 PM, Geoffrey Bays
wrote: line of the main function does do the trick:
sequence [putStrLn $ show s | s <- newList]
But this is the kind of thing that makes Haskell types difficult for beginners to work with...
Geoffrey
On Mon, Mar 9, 2015 at 4:15 PM, Joel Williamson
wrote: main must have type IO a. Hoogle tells me that to convert [IO a] -> IO [a], you should use the function sequence. Try applying that to your
final
line.
On Mon, 9 Mar 2015 16:07 Geoffrey Bays
wrote: My main function looks like this:
main :: [IO()] main = do let stud1 = Student {name = "Geoff", average = -99.0, grades = [66,77,88]} let stud2 = Student {name = "Doug", average = -99.0, grades = [77,88,99]} let stud3 = Student {name = "Ron", average = -99.0, grades = [55,66,77]} let studList = [stud1,stud2] let newList = calcAvg studList [putStrLn $ show s | s <- newList] --putStrLn $ show (newList !! 0) --putStrLn $ show (newList !! 1)
With this final line, putStrLn $ show (newList !! 0), the type IO () in the function declaration compiles fine. But with [putStrLn $ show s | s <- newList] as the final line, [IO ()]
in
the function declaration will not compile, I get this error:
Couldn't match expected type `IO t0' with actual type `[IO ()]'
What does the declared type need to be for a final line of: [putStrLn $ show s | s <- newList] ???
Thanks,
Geoffrey
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
-- Regards Sumit Sahrawat
participants (4)
-
David McBride
-
Geoffrey Bays
-
Joel Williamson
-
Sumit Sahrawat, Maths & Computing, IIT (BHU)