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.
Related
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.
Say I do the following from ghci:
Prelude Control.Exception Data.Typeable> let a = read "A" :: Int
Prelude Control.Exception Data.Typeable> a
*** Exception: Prelude.read: no parse
Great! Now I just need to somehow know the type (and the module) of this exception to write an exception handler. Is there any way to get said type and module?
Built upon Daniel Wagner's answer:
import Control.Exception
import Data.Typeable
whichException :: IO a -> IO ()
whichException act = do
e <- try act
case e of
Left (SomeException ex) -> print $ typeOf ex
_ -> putStrLn "No exception occurred"
-- Usage:
-- > whichException (evaluate (read "A"::Int))
-- ErrorCall
We know read comes from Prelude. So we can look at the Prelude documentation for read on Hackage, which includes a source link. From there, you can keep clicking on the error-y-looking part to follow the read-error-errorCallException-ErrorCall chain and learn that the appropriate exception to catch is GHC.Exception.ErrorCall. Testing in ghci:
> try (evaluate (read "A")) :: IO (Either ErrorCall Int)
Left Prelude.read: no parse
Seems to work!
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.
I have a function
import System.Exit
exit_and_report_type_mismatch :: String -> IO ExitCode
exit_and_report_type_mismatch error_message = do
putStrLn error_message
exitFailure
and a section of another like so
interpret_expr :: Vars -> Expr -> Val
interpret_expr vars (Plus (ConsE _ _) (NumE _)) = exit_and_report_type_mismatch "Type Error: Can only concatenate list (not int) to list"
Haskell complains to me that it is expecting type Val (another data type I have defined) but it actually receives type IO Exitcode. Fair enough - exit_and_report_mismatch is returning IO ExitCode which is not a Val.
How do I completely abort the Haskell program from within "exit_and_report_type_mismatch"? I have read a bit about Haskell exceptions but the explanations either do not make sense or mention having to call ExitWith from the main function, which is not an option.
This is what error is for. From the documentation:
error :: [Char] -> a
error stops execution and displays an error message.
For instance:
zsh% runhaskell <<<'main = putStrLn (error "Message") >> print "Not reached."'
runghcXXXX7729.hs: Message
The effect of putStrLn is ignored, and the program terminates as soon as the value produced by error is demanded (lazy evaluation means that just putting error somewhere doesn't immediately cause an error; as you might or might not expect, let x = error "Message" in putStrLn "Printed" causes no errors). It is possible to catch these exceptions with the functions from Control.Exception.Base, such as catch, but I've never done this nor have I seen this done.
Also, as a final note, consider avoiding the use of error. Partial functions (functions that aren't defined over their entire input domain) are best avoided when possible, as it's much easier to reason about your code with the stronger guarantees total functions provide. It's nice when, as for total functions, f :: A -> B really means "the function f returns something of type B"; for partial functions, f :: A -> B means only "if the function f returns, then what it returns is of type B". In your case, this might mean having a type like interpretExpr :: Vars -> Expr -> Either RuntimeError Val, or something suitably isomorphic (in the simplest case, perhaps data Result = Error String | Value Val, and interpretExpr :: Vars -> Expr -> Result).
This will do it:
import System.IO.Unsafe
exit_and_report_type_mismatch :: String -> a
exit_and_report_type_mismatch error_message = unsafePerformIO $ do
putStrLn error_message
exitFailure
The function error might work the same though.
I don't think it is a bug, but I am a bit puzzled as to why that doesn't work. A bonus question is why does it mention variable e? There is no variable e.
Prelude> :m +Control.Exception
Prelude Control.Exception> handle (\_-> return "err") undefined
<interactive>:1:0:
Ambiguous type variable `e' in the constraint:
`Exception e'
arising from a use of `handle' at <interactive>:1:0-35
Probable fix: add a type signature that fixes these type variable(s)
Prelude Control.Exception>
Apparently it works fine in ghci 6.8, I am using 6.10.1.
Edit: I have minimized the code. I expect that to have the same result in both 6.8 and 6.10
class C a
foo :: C a => (a -> Int)-> Int
foo _ = 1
arg :: C a => a -> Int
arg _ = 2
bar :: Int
bar = foo arg
trying to compile it:
[1 of 1] Compiling Main ( /tmp/foo.hs, interpreted )
/tmp/foo.hs:12:10:
Ambiguous type variable `a' in the constraint:
`C a' arising from a use of `arg' at /tmp/foo.hs:12:10-12
Probable fix: add a type signature that fixes these type variable(s)
Failed, modules loaded: none.
Prelude Control.Exception>
The type of Control.Exception.handle is:
handle :: Exception e => (e -> IO a) -> IO a -> IO a
The problem you are seeing is that the lambda expression (\_ -> return "err") is not of type e -> IO a where e is an instance of Exception. Clear as mud? Good. Now I'll provide a solution which should actually be useful :)
It just so happens in your case that e should be Control.Exception.ErrorCall since undefined uses error which throws ErrorCall (an instance of Exception).
To handle uses of undefined you can define something like handleError:
handleError :: (ErrorCall -> IO a) -> IO a -> IO a
handleError = handle
It's essentially an alias Control.Exception.handle with e fixed as ErrorCall which is what error throws.
It looks like this when run in GHCi 7.4.1:
ghci> handleError (\_ -> return "err") undefined
"err"
To handle all exceptions a handleAll function can be written as follows:
handleAll :: (SomeException -> IO a) -> IO a -> IO a
handleAll = handle
Catching all exceptions has consequences described well in this excerpt of the Control.Exception documentation:
Catching all exceptions
It is possible to catch all exceptions, by using the type SomeException:
catch f (\e -> ... (e :: SomeException) ...)
HOWEVER, this is normally not what you want to do!
For example, suppose you want to read a file, but if it doesn't exist then continue as if it contained "". You might be tempted to just catch all exceptions and return "" in the handler. However, this has all sorts of undesirable consequences. For example, if the user presses control-C at just the right moment then the UserInterrupt exception will be caught, and the program will continue running under the belief that the file contains "". Similarly, if another thread tries to kill the thread reading the file then the ThreadKilled exception will be ignored.
Instead, you should only catch exactly the exceptions that you really want. In this case, this would likely be more specific than even "any IO exception"; a permissions error would likely also want to be handled differently. Instead, you would probably want something like:
e <- tryJust (guard . isDoesNotExistError) (readFile f)
let str = either (const "") id e
There are occassions when you really do need to catch any sort of exception. However, in most cases this is just so you can do some cleaning up; you aren't actually interested in the exception itself. For example, if you open a file then you want to close it again, whether processing the file executes normally or throws an exception. However, in these cases you can use functions like bracket, finally and onException, which never actually pass you the exception, but just call the cleanup functions at the appropriate points.
But sometimes you really do need to catch any exception, and actually see what the exception is. One example is at the very top-level of a program, you may wish to catch any exception, print it to a logfile or the screen, and then exit gracefully. For these cases, you can use catch (or one of the other exception-catching functions) with the SomeException type.
Source: http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Exception.html#g:4
This problem shows up only in GHC 6.10; it can't be duplicated in GHC 6.8 because the type of handle is different:
: nr#homedog 620 ; ghci
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
Loading package base ... linking ... done.
Prelude> :m +Control.Exception
Prelude Control.Exception> handle (\_ -> return "err") undefined
"err"
Prelude Control.Exception>
OK maybe I can get this right at last. I think the problem is not the monomorphism restriction, but rather you've hit an instance of the Read/Show problem: you're offering to handle some type of exception, in the new version of `handle, there is more than one type of exception, and the type of that exception does not appear in your result. So the compiler has no way of knowing which type of exception you're trying to handle. One way to work this is to pick one. Here's some code that works:
Prelude Control.Exception> let alwaysError :: SomeException -> IO String; alwaysError = \_ -> return "err"
Prelude Control.Exception> handle alwaysError undefined
"err"
Incidentally, the example use of handle in the GHC library documentation does not compile under 6.10. I have filed a bug report.
A workaround is to use Control.OldException in ghc 6.10.* instead of Control.Exception.
Try giving your handler the type SomeException -> IO x, where x is a concrete type, e.g.
import Control.Exception
let f _ = putStrLn "error" :: SomeException -> IO ()
in handle f undefined
"Exception e" is likely from the type signature of "handle".
The documentation
says:
handle :: Exception e => (e -> IO a) -> IO a -> IO a
In GHC 6.8 it used to be different, which would explain why I don't get that error.
handle :: (Exception -> IO a) -> IO a -> IO a
Seems you're running into the monomorphism restriction. That "_"-Pattern must be monomorphic (which it is with ghc 6.8) or explicitly typed. A "workaround" is to put the pattern on the left hand side of a definition, where it constitutes a "simple pattern binding" as specified by the Haskell Report.
Try this:
let f _ = return "err"
handle f undefined
http://www.haskell.org/haskellwiki/Monomorphism_restriction