{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

import Control.Exception
import System.IO.Unsafe

testWHNF :: Exception e => a -> Maybe e
testWHNF x = unsafePerformIO $ catch (evaluate x >> pure Nothing) handle
  where handle (e :: SomeException) = pure (fromException e)

pattern IsException :: Exception e => e -> a
pattern IsException e <- (testWHNF -> Just e) where
  IsException e = throw e

pattern MkSomeException e = IsException (e :: SomeException)
pattern MkArithException e = IsException (e :: ArithException)

teaspoon :: a -> Maybe a
teaspoon x = unsafePerformIO $ catch (Just <$> evaluate x) handle
  where handle (e :: SomeException) = pure Nothing

pattern Pure :: a -> a
pattern Pure x <- (teaspoon -> Just x)

foo :: a -> String
foo (MkArithException e) = "ArithException: " ++ show e
foo (MkSomeException e) = "SomeException: " ++ show e
foo (Pure x) = "No exception thrown"

-- λ> foo (throw (toException DivideByZero ))
-- "ArithException: divide by zero"
-- λ> foo (throw (toException StackOverflow  ))
-- "SomeException: stack overflow"
-- λ> foo 123
-- "No exception thrown"