I am playing with exceptions in haskell and stumbled upon one thing I can't understand yet.
In GHCi I do:
Prelude Control.Exception> let thrower = (read "A") :: Int
Prelude Control.Exception> :{
Prelude Control.Exception| let main = do
Prelude Control.Exception| x <- (try $ return thrower) :: IO (Either SomeException Int)
Prelude Control.Exception| print x
Prelude Control.Exception| :}
Prelude Control.Exception> main
This defines thrower, my test expression that will fail with exception.
Then I define main that wraps that expression into try (wrapping it into IO first, since try accepts IO) and then unwraps it from IO (produced by try) and prints it.
Everything looks great so far - evaluating main in repl gives back exception wrapped into Either:
Right *** Exception: Prelude.read: no parse
However, if I try to compile and execute same code as an app:
module Main where
import Control.Exception
thrower = (read "A") :: Int
main = do
x <- (try $ return thrower) :: IO (Either SomeException Int)
print x
... it gets crashed with exception:
haskelltest.exe: Prelude.read: no parse
It seems like exception slipped past try.
What am I missing here and what is the correct way to handle this?
Well, basically (as Sebastian Redl pointed out earlier) this is a strictness issue. return thrower does not in any way evaluate thrower, so try succeeds. Only when the content of the Either SomeException Int is printed, namely Right thrower, does read actually try to parse "A", and fails... but at this point, the try is already over.
The way to prevent this is to inject the parse result strictly into the IO monad, with
main = do
x <- try $ evaluate thrower :: IO (Either SomeException Int)
print x
Why the try fails with your code in GHCi I don't know; I daresay it shouldn't. Aha: as Reid noted, it doesn't fail actually!
Arguably, this is an example for why exceptions should generally be avoided in Haskell. Use a suitable monad transformer to make it explicit what errors might occur, and to get reliable evaluation of the error-checking.
Part of what you're missing is that when you ran your code in ghci, try also did not catch the error raised by read "A" :: Int. Weren't you expecting a Left <something> result? See leftaroundabout's answer for why that is.
The difference between ghci and ghc here is probably due to output buffering: output to stdout (like "Right " here) is unbuffered in ghci, but line buffered by default in a compiled program.
Related
In my Haskell program, I want to read in a value given by the user using the getLine function. I then want to use the read function to convert this value from a string to the appropriate Haskell type. How can I catch parse errors thrown by the read function and ask the user to reenter the value?
Am I right in thinking that this is not an "IO Error" because it is not an error caused by the IO system not functioning correctly? It is a semantic error, so I can't use IO error handling mechanisms?
You don't want to. You want to use reads instead, possibly like that:
maybeRead = fmap fst . listToMaybe . reads
(though you might want to error out if the second element of the tuple is not "", that is, if there's a remaining string, too)
The reason why you want to use reads instead of catching error exceptions is that exceptions in pure code are evil, because it's very easy to attempt to catch them in the wrong place: Note that they only fly when they are forced, not before. Locating where that is can be a non-trivial exercise. That's (one of the reasons) why Haskell programmers like to keep their code total, that is, terminating and exception-free.
You might want to have a look at a proper parsing framework (e.g. parsec) and haskeline, too.
There are readMaybe and readEither that satisfy your expectation. You find this functions in Text.Read package.
This is an addendum to #barsoap's answer more than anything else.
Haskell exceptions may be thrown anywhere, including in pure code, but they may only be caught from within the IO monad. In order to catch exceptions thrown by pure code, you need to use a catch or try on the IO statement that would force the pure code to be evaluated.
str2Int :: String -> Int -- shortcut so I don't need to add type annotations everywhere
str2Int = read
main = do
print (str2Int "3") -- ok
-- print (str2Int "a") -- raises exception
eVal <- try (print (str2Int "a")) :: IO (Either SomeException ())
case eVal of
Left e -> do -- couldn't parse input, try again
Right n -> do -- could parse the number, go ahead
You should use something more specific than SomeException because that will catch anything. In the above code, the try will return a Left exception if read can't parse the string, but it will also return a Left exception if there's an IO error when trying to print the value, or any number of other things that could possibly go wrong (out of memory, etc.).
Now, here's why exceptions from pure code are evil. What if the IO code doesn't actually force the result to be evaluated?
main2 = do
inputStr <- getLine
let data = [0,1,read inputStr] :: [Int]
eVal <- try (print (head data)) :: IO (Either SomeException ())
case eVal of
Right () -> do -- No exception thrown, so the user entered a number ?!
Left e -> do -- got an exception, probably couldn't read user input
If you run this, you'll find that you always end up in the Right branch of the case statement, no matter what the user entered. This is because the IO action passed to try doesn't ever try to read the entered string. It prints the first value of the list data, which is constant, and never touches the tail of the list. So in the first branch of the case statement, the coder thinks the data is evaluated but it isn't, and read may still throw an exception.
read is meant for unserializing data, not parsing user-entered input. Use reads, or switch to a real parser combinator library. I like uu-parsinglib, but parsec, polyparse, and many others are good too. You'll very likely need the extra power before long anyway.
Here's an improved maybeRead which allows only for trailing whitespaces, but nothing else:
import Data.Maybe
import Data.Char
maybeRead2 :: Read a => String -> Maybe a
maybeRead2 = fmap fst . listToMaybe . filter (null . dropWhile isSpace . snd) . reads
I am trying to get a firm grasp of exceptions, so that I can improve my conditional loop implementation. To this end, I am staging various experiments, throwing stuff and seeing what gets caught.
This one surprises me to no end:
% cat X.hs
module Main where
import Control.Exception
import Control.Applicative
main = do
throw (userError "I am an IO error.") <|> print "Odd error ignored."
% ghc X.hs && ./X
...
X: user error (I am an IO error.)
% cat Y.hs
module Main where
import Control.Exception
import Control.Applicative
main = do
throwIO (userError "I am an IO error.") <|> print "Odd error ignored."
% ghc Y.hs && ./Y
...
"Odd error ignored."
I thought that the Alternative should ignore exactly IO errors. (Not sure where I got this idea from, but I certainly could not offer a non-IO exception that would be ignored in an Alternative chain.) So I figured I can hand craft and deliver an IO error. Turns out, whether it gets ignored depends on the packaging as much as the contents: if I throw an IO error, it is somehow not anymore an IO error.
I am completely lost. Why does it work this way? Is it intended? The definitions lead deep into the GHC internal modules; while I can more or less understand the meaning of disparate fragments of code by themselves, I am having a hard time seeing the whole picture.
Should one even use this Alternative instance if it is so difficult to predict? Would it not be better if it silenced any synchronous exception, not just some small subset of exceptions that are defined in a specific way and thrown in a specific way?
throw is a generalization of undefined and error, it's meant to throw an exception in pure code. When the value of the exception does not matter (which is most of the time), it is denoted by the symbol ⟘ for an "undefined value".
throwIO is an IO action which throws an exception, but is not itself an undefined value.
The documentation of throwIO thus illustrates the difference:
throw e `seq` x ===> throw e
throwIO e `seq` x ===> x
The catch is that (<|>) is defined as mplusIO which uses catchException which is a strict variant of catch. That strictness is summarized as follows:
⟘ <|> x = ⟘
hence you get an exception (and x is never run) in the throw variant.
Note that, without strictness, an "undefined action" (i.e., throw ... :: IO a) actually behaves like an action that throws from the point of view of catch:
catch (throw (userError "oops")) (\(e :: SomeException) -> putStrLn "caught") -- caught
catch (throwIO (userError "oops")) (\(e :: SomeException) -> putStrLn "caught") -- caught
catch (pure (error "oops")) (\(e :: SomeException) -> putStrLn "caught") -- not caught
Say you have
x :: Integer
That means that x should be an integer, of course.
x = throw _whatever
What does that mean? It means that there was supposed to be an Integer, but instead there’s just a mistake.
Now consider
x :: IO ()
That means x should be an I/O-performing program that returns no useful value. Remember, IO values are just values. They are values that just happen to represent imperative programs. So now consider
x = throw _whatever
That means that there was supposed to be an I/O-performing program there, but there is instead just a mistake. x is not a program that throws an error—there is no program. Regardless of whether you’ve used an IOError, x isn’t a valid IO program. When you try to execute the program
x <|> _whatever
You have to execute x to see whether it throws an error. But, you can’t execute x, because it’s not a program—it’s a mistake. Instead, everything explodes.
This differs significantly from
x = throwIO _whatever
Now x is a valid program. It is a valid program that always happens to throw an error, but it’s still a valid program that can actually be executed. When you try to execute
x <|> _whatever
now, x is executed, the error produced is discarded, and _whatever is executed in its place. You can also think of there being a difference between computing a program/figuring out what to execute and actually executing it. throw throws the error while computing the program to execute (it is a "pure exception"), while throwIO throws it during execution (it is an "impure exception"). This also explains their types: throw returns any type because all types can be "computed", but throwIO is restricted to IO because only programs can be executed.
This is further complicated by the fact that you can catch the pure exceptions that occur while executing IO programs. I believe this is a design compromise. From a theoretical perspective, you shouldn't be able to catch pure exceptions, because their presence should always be taken to indicate programmer error, but that can be rather embarrassing, because then you can only handle external errors, while programmer errors cause everything to blow up. If we were perfect programmers, that would be fine, but we aren't. Therefore, you are allowed to catch pure exceptions.
is :: [Int]
is = []
-- fails, because the print causes a pure exception
-- it was a programmer error to call head on is without checking that it,
-- in fact, had a head in the first place
-- (the program on the left is not valid, so main is invalid)
main1 = print (head is) <|> putStrLn "Oops"
-- throws exception
-- catch creates a program that computes and executes the program print (head is)
-- and catches both impure and pure exceptions
-- the program on the left is invalid, but wrapping it with catch
-- makes it valid again
-- really, that shouldn't happen, but this behavior is useful
main2 = print (head is) `catch` (\(_ :: SomeException) -> putStrLn "Oops")
-- prints "Oops"
The rest of this answer may not be entirely correct. But fundamentally, the difference is this: throwIO terminates and returns an IO action, while throw does not terminate.
As soon as you try to evaluate throw (userError "..."), your program aborts. <|> never gets a chance to look at its first argument to decide if the second argument should be evaluated; in fact, it never gets the first argument, because throw didn't return a value.
With throwIO, <|> isn't evaluating anything; it's creating a new IO action which, when it does get executed, will first look at its first argument. The runtime can "safely" execute the IO action and see that it does not, in fact, provide a value, at which point it can stop and try the other "half" of the <|> expression.
I want to write a function which, when called, will relentlessly ask for user input until the input can be read as an integer, (at which point the integer is returned to a possible do block where the function was called in the first place)
My code here:
lp_reqInt =
do
input1 <- getLine
if ((readMaybe input1 :: Maybe Int) == Nothing)
then do
putStrLn "(integer input required, please try again)"
lp_reqInt
else let output = fromMaybe (-666) (readMaybe input1 :: Maybe Int)
return output
trying to compile this gives the suspiciously simple error of parse error (possibly incorrect indentation or mismatched brackets) for the last line. (No indent characters were used throughout the whole file)
How should I change my code to have the intended behaviour? Is that even possible?
The other answer discusses what was wrong, and the minimal fix. In addition to the minimal thing that will get you moving on with your code, I thought it might also be interesting to show the idiomatic fix, namely, to use pattern matching instead of if. So:
lp_reqInt :: IO Int
lp_reqInt = do
input1 <- getLine
case readMaybe input1 of
Nothing -> do
putStrLn "(integer input required, please try again)"
lp_reqInt
Just n -> return n
This doesn't require the use of the weird fall-back -666 in fromMaybe, which is nice. Using pattern matching instead of (==) also has a more subtle advantage: it doesn't require the underlying type to have an Eq instance. For Int there is one, so there's no advantage in this code, but in other situations it can matter more. I've also lifted the type signature to the top-level; see here for further discussion of this idiom.
You seem to be slightly misunderstanding how do-notation works.
I'll give you a 'correct' version and we can work off that:
lp_reqInt = do
input1 <- getLine
let maybeInput = readMaybe input1 :: Maybe Int
if maybeInput == Nothing
then do putStrLn "(integer input required, please try again)"
lp_reqInt
else return $ (\(Just x) -> x) maybeInput
Note the let-statement at the top there. I can do a let-statement rather than a let-in-statement here, because it is in the top level of a do-block. When you wrote let output = fromMaybe (...), that was not in the top level of a do-block, that was in the second part of an if-statement, hence it will not work.
You were getting a parse error for this very reason: GHC expected an accompanying in!
Previous answers are great but i just would like to extend this topic with another reasonable approach for those who end up here searching not exactly what the OP is asking for but something relevant.
Since the topic mentions User Input (IO) and Integer (Maybe Int) we end up with a type like IO (Maybe Int). Such types are best expressed under the Monad Transformers, namely MaybeT IO Int and they act nicely as Alternative class members as well.
Haskell has fantastic solutions for these cases such that we may approach the same problem like;
import Control.Monad (msum)
import Control.Monad.Trans.Maybe
import Control.Monad.Trans (lift)
import Text.Read (readMaybe)
lp_reqInt :: MaybeT IO Int
lp_reqInt = msum . repeat $ (lift . putStrLn) "Enter an integer.." >>
(MaybeT $ readMaybe <$> getLine)
It's relentless :)
λ> runMaybeT lp_reqInt
Enter an integer..
boru
Enter an integer..
not an integer
Enter an integer..
42
Just 42
Can I write a test case with Test.HUnit that checks whether a call throws an exception?
I only care whether it throws any error, regardless of what message it prints.
This isn't specific to HUnit, but you can write a function to check whether an IO value throws:
λ> :set -XScopedTypeVariables
λ> import Control.Exception
λ> import Data.Functor
λ> import System.Environment
λ> throws io = catch (io $> False) $ \(e :: SomeException) -> pure True
throws :: IO a -> IO Bool
λ> sequence $ throws <$> [ getEnv "HOME", getEnv "whatever", error "a" ]
[False,True,True]
If by an "exception" you mean Exception and it is being thrown in some IO code, then you can use catch or catches. However, if you mean catching things like error "Something bad happened" in pure code, you are out of luck. If you are willing to do the handling in IO, you have more options:
ghci> import Control.Exception
ghci> catch (error "Eek") (\(ErrorCallWithLocation msg _) -> putStrLn msg)
Eek
From the Haskell 2010 report section 3:
Errors during expression evaluation, denoted by ⊥ (“bottom”), are indistinguishable by a Haskell program from non-termination.
Here is another way to think about it: notice that the moment we try to evaluate a value that is ⊥ (like error "Help!") depends not on when this value was created but only when it was first needed (since Haskell is non-strict). A mechanism to catch this sort of error would then break referential transparency.
In my Haskell program, I want to read in a value given by the user using the getLine function. I then want to use the read function to convert this value from a string to the appropriate Haskell type. How can I catch parse errors thrown by the read function and ask the user to reenter the value?
Am I right in thinking that this is not an "IO Error" because it is not an error caused by the IO system not functioning correctly? It is a semantic error, so I can't use IO error handling mechanisms?
You don't want to. You want to use reads instead, possibly like that:
maybeRead = fmap fst . listToMaybe . reads
(though you might want to error out if the second element of the tuple is not "", that is, if there's a remaining string, too)
The reason why you want to use reads instead of catching error exceptions is that exceptions in pure code are evil, because it's very easy to attempt to catch them in the wrong place: Note that they only fly when they are forced, not before. Locating where that is can be a non-trivial exercise. That's (one of the reasons) why Haskell programmers like to keep their code total, that is, terminating and exception-free.
You might want to have a look at a proper parsing framework (e.g. parsec) and haskeline, too.
There are readMaybe and readEither that satisfy your expectation. You find this functions in Text.Read package.
This is an addendum to #barsoap's answer more than anything else.
Haskell exceptions may be thrown anywhere, including in pure code, but they may only be caught from within the IO monad. In order to catch exceptions thrown by pure code, you need to use a catch or try on the IO statement that would force the pure code to be evaluated.
str2Int :: String -> Int -- shortcut so I don't need to add type annotations everywhere
str2Int = read
main = do
print (str2Int "3") -- ok
-- print (str2Int "a") -- raises exception
eVal <- try (print (str2Int "a")) :: IO (Either SomeException ())
case eVal of
Left e -> do -- couldn't parse input, try again
Right n -> do -- could parse the number, go ahead
You should use something more specific than SomeException because that will catch anything. In the above code, the try will return a Left exception if read can't parse the string, but it will also return a Left exception if there's an IO error when trying to print the value, or any number of other things that could possibly go wrong (out of memory, etc.).
Now, here's why exceptions from pure code are evil. What if the IO code doesn't actually force the result to be evaluated?
main2 = do
inputStr <- getLine
let data = [0,1,read inputStr] :: [Int]
eVal <- try (print (head data)) :: IO (Either SomeException ())
case eVal of
Right () -> do -- No exception thrown, so the user entered a number ?!
Left e -> do -- got an exception, probably couldn't read user input
If you run this, you'll find that you always end up in the Right branch of the case statement, no matter what the user entered. This is because the IO action passed to try doesn't ever try to read the entered string. It prints the first value of the list data, which is constant, and never touches the tail of the list. So in the first branch of the case statement, the coder thinks the data is evaluated but it isn't, and read may still throw an exception.
read is meant for unserializing data, not parsing user-entered input. Use reads, or switch to a real parser combinator library. I like uu-parsinglib, but parsec, polyparse, and many others are good too. You'll very likely need the extra power before long anyway.
Here's an improved maybeRead which allows only for trailing whitespaces, but nothing else:
import Data.Maybe
import Data.Char
maybeRead2 :: Read a => String -> Maybe a
maybeRead2 = fmap fst . listToMaybe . filter (null . dropWhile isSpace . snd) . reads