I'm trying to dive into building concurrent and robust code with Haskell, and it was recommended that I use the safe-exceptions and async libraries. However, I'm having a hard time understanding how to handle non-fatal errors thrown within an async action.
For instance, if there is a simple loop that is checking a network resource every n seconds, it would make sense to stop this using the cancel function which would cause an AsyncCancelled exception to be thrown within the seperate thread. Of course, there would also be the possibility that an IOError would be thrown from within the thread due to the network going down or some other problem. Depending on the type of exception and the data it contains, I would want to control whether the seperate thread ignores the exception, performs some action, stops, or raises the exception in the main thread.
With the safe-exceptions library, the only functions that are able to do this are catchAsync and others like it, which are labelled as dangerous in the documentation. Other than that, there is waitCatch in the async library, but the fromException function always returns Nothing when I try to extract an IOError:
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Concurrent.Async
import Control.Concurrent hiding (throwTo)
import Control.Exception.Safe
import Control.Monad
import System.IO
import System.IO.Error hiding (catchIOError)
main = do
hSetBuffering stdin NoBuffering
putStrLn "Press any key to continue..."
a <- async runLoop
async $ hWaitForInput stdin (-1) *>
throwTo (asyncThreadId a) (userError "error")
waitCatch a >>= either handler nothing
where
printThenWait i = putStr (show i ++ " ") *> threadDelay 1000000
runLoop = sequence_ $ printThenWait <$> [1..]
nothing _ = pure ()
handler e
| Just (e' :: IOError) <- fromException e =
putStrLn "It's an IOError!"
| (Nothing :: Maybe IOError) <- fromException e =
putStrLn "We got Nothing!"
I'm a bit confused about the danger of recovering from async exceptions, especially when standard functions such as cancel cause them to be thrown, and I don't know what the recommended way to handle them would be when using these two libraries. Is this an instance where catchAsync would be recommended, or is there another way to handle these types of situations that I haven't discovered?
Notice that Control.Exception.Safe.throwTo wraps synchronous exceptions into AsyncExceptionWrapper, and IOError is synchronous. (I have no idea why this wrapping is necessary, you should never throw synchronous exceptions asynchronously anyway.)
To make your code work, you should either catch AsyncExceptionWrapper or use Control.Exception.throwTo. But actually I don't compitely understand what you are trying to do, most likely you are overcomplicating things.
Related
I am playing with async library and trying to figure out its API in practice. I've noticed a strange behavior I didn't expect. It looks like a bug, but maybe it's a feature and I just need to know a workaround.
import Control.Concurrent
import Control.Concurrent.Async
> withAsync (putStrLn "HELLO") (\_ -> putStrLn "WORLD")
WORLHEDL
The snippet above is working just fine - both line lines executed, but more complex async body is evaluated partially.
> withAsync (putStrLn "XXXXXXXXXX" >> putStrLn "HELLO") (\_ -> putStrLn "WORLD")
WOXRXLXDX
See, the second putStrLn is not executed.
I guess I need to wrap the whole async body in some sort of bnf, but it looks weird anyway. Why withAsync doesn't do that for me?
forkIO works just right, but I don't want to bother with unlifting.
async has pair library unlift-async which propagates monad automatically.
forkIO (Prelude.putStrLn "XXXXXXXXXX" >> Prelude.putStrLn "HELLO")
ThreadXIXdX X1X1X3X
XXX
HELLO
I found lifted-base with fork function. It works as forkIO and pass parent monad to child thread.
withAsync interrupts the forked thread (1st argument) when the main thread (2nd argument) terminates. This is explicit in the documentation of withAsync:
When the function returns or throws an exception, uninterruptibleCancel is called on the Async.
(...) This is a useful variant of async that ensures an Async is never left running unintentionally.
If you want to just fork a thread, use async.
async (putStrLn "XXXXXXXX" >> putStrLn "WORLD") >> putStrLn "HELLO"
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 have to write a command line tool gluing together some components for an experiment and need help for a code design that meet my requirements.
At top level I have to work with samples each generated by a – in runtime as well as in memory consumption – expensive call to another program with the function "System.Process.readProcessWithExitCode". Therefore you can imagine to have a (expensive) function "genSample :: IO a" and you need n return values of that function.
My requirements are:
1. Let p be the number of processors, then at most p samples (i.e. calls to genSample) should be computed in parallel.
2. A timeout should be possible set which aborts the generation of the samples.
3. If the computation of all the samples times out, the started processes within a genSample-call should be stopped
My current solution meets requirements 1 and 2. For the third one I currently help myself by executing a killall-command. That seems to be a dirty hack to me. Perhaps someone has a better idea?
Here the central part of my current solution:
import qualified Control.Monad.Par.Class as ParIO
import qualified Control.Monad.Par.IO as ParIO
…
-- | #parRepeatM i n a# performs action #a# #n# times in parallel with timeout #t#
parRepeatM :: ParIO.NFData a =>
Integer -- ^ timeout in seconds
-> Integer -- ^ number of duplicates (here: number of req. samples)
-> IO a -- ^ action to perform (here: genSample)
-> IO (Maybe [a])
parRepeatM t n a = timeout t $ ParIO.runParIO $ do
let tasks = genericReplicate n $ liftIO a -- :: [ParIO a]
ivars <- mapM ParIO.spawn tasks
mapM ParIO.get ivars
A central problem at the moment is that after abortion due to a timeout the command called within genSample continues it's execution – in the worst case until the whole haskell-gluing-program ends.
In Haskell, cancellation is usually handled through asynchronous exceptions. That's what timeout seems to use.
So, we can try to install an exception handler in the code that executes the external process. The handler will invoke terminateProcess whenever an exception (asynchronous or not) crops up. Because terminateProcess requires a reference to the
process handle, we'll have to use createProcess instead of the higher-level readProcessWithExitCode.
First, some imports and auxiliary functions (I'm using the async package):
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Applicative
import Control.Exception
import Control.Concurrent (threadDelay, MVar, newEmptyMVar, putMVar, takeMVar)
import Control.Concurrent.Async (race_, Concurrently(..), waitEither, withAsync)
import System.Process
import System.Exit
import System.IO
import qualified Data.ByteString as B
-- Executes two actions concurrently and returns the one that finishes first.
-- If an asynchronous exception is thrown, the second action is terminated
-- first.
race' :: IO a -> IO a -> IO a
race' left right =
withAsync left $ \a ->
withAsync right $ \b ->
fmap (either id id) (waitEither a b)
-- terminate external process on exception, ignore if already dead.
terminateCarefully :: ProcessHandle -> IO ()
terminateCarefully pHandle =
catch (terminateProcess pHandle) (\(e::IOException) -> return ())
This function launches an external process and returns its stdout and exit code, terminating the process if the thread is cancelled:
safeExec :: CreateProcess -> IO (B.ByteString, ExitCode)
safeExec cp =
bracketOnError
(createProcess cp {std_out = CreatePipe})
(\(_,_ ,_,pHandle) -> terminateCarefully pHandle)
(\(_,Just hOut,_,pHandle) -> do
-- Workaround for a Windows issue.
latch <- newEmptyMVar
race'
(do -- IO actions are uninterruptible on Windows :(
takeMVar latch
contents <- B.hGetContents hOut
ec <- waitForProcess pHandle
pure (contents,ec))
-- Dummy interruptible action that
-- receives asynchronous exceptions first
-- and helps to end the other action.
(onException
(do
putMVar latch ()
-- runs forever unless interrupted
runConcurrently empty)
(terminateCarefully pHandle)))
About the implementation:
bracketOnError is used to ensure that the external process is killed if an exception happens.
In Windows, I/O operations like reading from a Handle are uninterruptible (see https://ghc.haskell.org/trac/ghc/ticket/7353). This means they are impervious to asynchronous exceptions. As a workaround to this, I create a "dummy" thread that waits forever (runConcurrently empty) and can be interrupted by exceptions. When it is interrupted, it terminates the external process, causing the reads in the companion thread to finish, making the companion thread vulnerable to asynchronous exceptions again.
The "latch" is used to prevent any uninterruptible operation on the handle until the inner exception handler is installed.
It's a bit convoluted but it seems to work, at least tested with:
main :: IO ()
main = do
race_ (safeExec $ proc "calc" [])
(threadDelay (3*10^6))
The calc app is killed after three seconds. Here's the whole gist.
Remember also that:
on Windows, if the process was a shell command created by createProcess with shell, or created by runCommand or runInteractiveCommand, then terminateProcess will only terminate the shell, not the command itself.
I'm surprised I couldn't find an answer to this anywhere.
I'm writing a roguelike and I'm using the ncurses library from hackage, which is a pretty good wrapper around the ncurses library. Now ncurses has this quirk where if you try to write the bottom right character, it does so, then it tries to move the cursor to the next character, then it fails because there's nowhere to move it to. It returns an error value that you can only ignore.
My problem is that the haskell ncurses library writer dutifully checks for any errors on all calls, and when there is one, he calls: error "drawText: etc etc.".
In other languages, like c or python, to get around this you are forced to ignore the error or catch and ignore the exception, but for the life of me I can't figure out how to do it in haskell. Is the error function unrecoverable?
I will modify the library locally to not check for errors on that function if I have to, but I hate to do that. I'm also open to any workaround that would allow me to draw that last character without moving the cursor, but I don't think that is possible.
You can do this using catch from Control.Exception. Note, however, that you need to be in the IO monad to do this.
import qualified Control.Exception as Exc
divide :: Float -> Float -> Float
divide x 0 = error "Division by 0."
divide x y = x / y
main :: IO ()
main = Exc.catch (print $ divide 5 0) handler
where
handler :: Exc.ErrorCall -> IO ()
handler _ = putStrLn $ "You divided by 0!"
error is supposed to be as observable as an infinite loop. You can only catch error in IO, which is like saying "yeah you can if you know magic". But from the really nice part of Haskell, pure code, it is unrecoverable, and thus it is strongly advised not to use in your code, only as much as you would ever use an infinite loop as an error code.
ncurses is being rude and making you do magic to correct it. I'd say unsafePerformIO would be warranted to clean it up. Other than that, this is largely the same as Paul's answer.
import qualified Control.Exception as Exc
{-# NOINLINE unsafeCleanup #-}
unsafeCleanup :: a -> Maybe a
unsafeCleanup x = unsafePerformIO $ Exc.catch (x `seq` return (Just x)) handler
where
handler exc = return Nothing `const` (exc :: Exc.ErrorCall)
Then wrap unsafeCleanup around any value that would evaluate to an error to turn it into a Maybe.
This is available in the spoon package if you don't want to write it yourself (and you shouldn't -- exception code can be really tricky, especially in the presence of threads).
I built a really simple read-eval-print-loop in Haskell that catches Control-C (UserInterrupt). However, whenever I compile and run this program, it always catches the first Control-C and always aborts on the second Control-C with exit code 130. It doesn't matter how many lines of input I give it before and between the two Control-Cs, it always happens this way. I know I must be missing something simple... please help, thanks!
Note: this is with base-4 exceptions, so Control.Exception and not Control.OldException.
import Control.Exception as E
import System.IO
main :: IO ()
main = do hSetBuffering stdout NoBuffering
hSetBuffering stdin NoBuffering
repLoop
repLoop :: IO ()
repLoop
= do putStr "> "
line <- interruptible "<interrupted>" getLine
if line == "exit"
then putStrLn "goodbye"
else do putStrLn $ "input was: " ++ line
repLoop
interruptible :: a -> IO a -> IO a
interruptible a m
= E.handleJust f return m
where
f UserInterrupt
= Just a
f _
= Nothing
Wei Hu is correct; the Haskell runtime system deliberately aborts the program when a second control-C is pressed. To get the behavior one might expect:
import Control.Exception as E
import Control.Concurrent
import System.Posix.Signals
main = do
tid <- myThreadId
installHandler keyboardSignal (Catch (throwTo tid UserInterrupt)) Nothing
... -- rest of program
Disclaimer: I'm not familiar with GHC internals and my answer is based on grepping the source code, reading the comments, and making guesses.
The main function you define is in fact wrapped by runMainIO defined in GHC.TopHandler (this is further confirmed by looking at TcRnDriver.lhs):
-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
-- called in the program). It catches otherwise uncaught exceptions,
-- and also flushes stdout\/stderr before exiting.
runMainIO :: IO a -> IO a
runMainIO main =
do
main_thread_id <- myThreadId
weak_tid <- mkWeakThreadId main_thread_id
install_interrupt_handler $ do
m <- deRefWeak weak_tid
case m of
Nothing -> return ()
Just tid -> throwTo tid (toException UserInterrupt)
a <- main
cleanUp
return a
`catch`
topHandler
And install_interrupt_handler is defined as:
install_interrupt_handler :: IO () -> IO ()
#ifdef mingw32_HOST_OS
install_interrupt_handler handler = do
_ <- GHC.ConsoleHandler.installHandler $
Catch $ \event ->
case event of
ControlC -> handler
Break -> handler
Close -> handler
_ -> return ()
return ()
#else
#include "rts/Signals.h"
-- specialised version of System.Posix.Signals.installHandler, which
-- isn't available here.
install_interrupt_handler handler = do
let sig = CONST_SIGINT :: CInt
_ <- setHandler sig (Just (const handler, toDyn handler))
_ <- stg_sig_install sig STG_SIG_RST nullPtr
-- STG_SIG_RST: the second ^C kills us for real, just in case the
-- RTS or program is unresponsive.
return ()
On Linux, stg_sig_install is a C function that calls out to sigaction. The parameter STG_SIG_RST is translated to SA_RESETHAND. On Windows, things are done differently, which probably explains ja's observation.
The most reliable solution for me (at least on Linux), has been to install a signal handler using System.Posix.Signals. I was hoping for a solution that would not require this, but the real reason I posted the question was that I wanted to know why GHC behaved the way it did. As explained on #haskell, a likely explanation is that GHC behaves this way so that the user can always Control-C an application if it hangs. Still, it would be nice if GHC provided a way to affect this behavior without the somewhat lower-level method that we resorted to :).