-- Needed:
{-# LANGUAGE ExistentialQuantification #-}
-- Makes life easier:
{-# LANGUAGE PatternSignatures, DeriveDataTypeable #-}

module Examples where

import Control.Exception (Exception(..), SomeException, throw, catch, catchAny)
import Data.Typeable
import Prelude hiding (catch)

----------------------------------------------------------------------
-- Defining exceptions

-- Defining a subset of exceptions: Arithmetic exceptions

data SomeArithException = forall e . Exception e => SomeArithException e
    deriving Typeable

instance Show SomeArithException where
    show (SomeArithException e) = show e

instance Exception SomeArithException

arithToException :: Exception e => e -> SomeException
arithToException = toException . SomeArithException

arithFromException :: Exception e => SomeException -> Maybe e
arithFromException x = do
    SomeArithException a <- fromException x
    cast a

-- Defining a subset of arithmetic exceptions: FP exceptions

-- Note that when we make a subset of anything other than SomeException,
-- we need to actually define the methods in the Exception instance

data SomeFloatException = forall e . Exception e => SomeFloatException e
    deriving Typeable

instance Show SomeFloatException where
    show (SomeFloatException e) = show e

instance Exception SomeFloatException where
    toException = arithToException
    fromException = arithFromException

floatToException :: Exception e => e -> SomeException
floatToException = toException . SomeFloatException

floatFromException :: Exception e => SomeException -> Maybe e
floatFromException x = do
   SomeFloatException a <- fromException x
   cast a

-- Defining an actual exception.

-- Define DivideByZero and Overflow, both arithmetic exceptions.

data DivideByZero = DivideByZero
    deriving (Typeable, Show)

instance Exception DivideByZero where
    toException   = arithToException
    fromException = arithFromException

data Overflow = Overflow
    deriving (Typeable, Show)

instance Exception Overflow where
    toException   = arithToException
    fromException = arithFromException

----------------------------------------------------------------------
-- Usage examples

-- Note that the type signatures would normally not be necessary, as
-- in real programs the types would normally be inferred.
-- The exception is (e :: SomeException), for which catchAny can be used
-- instead.

-- A divide by zero exception can be caught as a DivideByZero...
example1 :: IO ()
example1 = throw DivideByZero `catch` \(e :: DivideByZero) -> print e

-- ...or a SomeArithException...
example2 :: IO ()
example2 = throw DivideByZero `catch` \(e :: SomeArithException) -> print e

-- ...or a SomeException...
example3 :: IO ()
example3 = throw DivideByZero `catch` \(e :: SomeException) -> print e

-- ... or with catchAny.
example4 :: IO ()
example4 = throw DivideByZero `catchAny` \e -> print e

-- We can see that if DivideByZero is caught then we don't hit the fall
-- through catchAny...
example5 :: IO ()
example5 = (throw DivideByZero `catch` \(e :: DivideByZero) -> print e)
           `catchAny` \_ -> putStrLn "Fell through"

-- ...but if it isn't, then we do.
example6 :: IO ()
example6 = (throw DivideByZero `catch` \(e :: Overflow) -> print e)
           `catchAny` \_ -> putStrLn "Fell through"

--

examples :: IO ()
examples = do
    example1
    example2
    example3
    example4
    example5
    example6