catch-them-all.hs

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Exception
import Control.Concurrent
import Control.Concurrent.Async

tryAll1 :: IO a -> IO (Either SomeException a)
tryAll1 = try

tryAll2 :: IO a -> IO (Either SomeException a)
tryAll2 action = withAsync action waitCatch

tryAll3 :: IO a -> IO (Either SomeException a)
tryAll3 =
    handle onExc . fmap Right
  where
    onExc e
        | shouldCatch e = return $ Left e
        | otherwise = throwIO e
    shouldCatch e
        | show e == "<<timeout>>" = False
        | Just (_ :: AsyncException) <- fromException e = False
        | otherwise = True

tryAll 1 = tryAll1
tryAll 2 = tryAll2
tryAll 3 = tryAll3

main :: IO ()
main = mapM_ test [1..3]

test i = do
    putStrLn $ "Starting test: " ++ show i
    tid <- forkIO $ do
        putStrLn "Starting the main thread"
        eres <- tryAll i $ do
            putStrLn "here1"
            threadDelay 20000
            putStrLn "here2"
        print eres
        putStrLn "Going to continue working..."
    threadDelay 10000
    eres <- try $ readFile "does-not-exist"
    case eres of
        Left e -> throwTo tid (e :: IOException)
        Right _ -> putStrLn "I thought it didn't exist"
    threadDelay 50000
    putStrLn "\n\n"

output.txt

Starting test: 1
Starting the main thread
here1
Left does-not-exist: openFile: does not exist (No such file or directory)
Going to continue working...



Starting test: 2
Starting the main thread
here1
test.hs: does-not-exist: openFile: does not exist (No such file or directory)



Starting test: 3
Starting the main thread
here1
Left does-not-exist: openFile: does not exist (No such file or directory)
Going to continue working...