module Main where
newtype Cont r a = Cont { runCont :: (a -> r) -> r }
onInput :: Cont (IO ()) String
onInput f = do
s <- getLine
f s
onInput f
main :: IO ()
main = onInput print
I fails to compile:
"Couldn't match expected type ‘Cont (IO ()) String’
with actual type ‘(String -> IO a0) -> IO b0’
• The equation(s) for ‘onInput’ have one argument,
but its type ‘Cont (IO ()) String’ has none"
But I thought Cont a b would be expanded to (b -> a) -> a so that Cont (IO ()) String became (String -> IO ()) -> IO (), and if I give that type using `type` instead of `newtype`, it does type-check:
type Cont r a = (a -> r) -> r
What am I missing here about Haskell?
thanks folks!