Exception Scoping 5

gistfile1.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

import Control.DeepSeq
import Control.DeepSeq.TH
import Control.Exception
import Data.Typeable

import Prelude hiding (catch)

data FieldAssignmentException = FieldAssignmentException String String deriving (Typeable)


instance Show FieldAssignmentException where
  show (FieldAssignmentException fieldName message) = "FieldAssignmentException fieldName=" ++ fieldName ++ " innerMessage=" ++ message

instance Exception FieldAssignmentException

safeCatch :: (Exception e, NFData a) => IO a -> (e -> IO a) -> IO a
safeCatch func handler = catch eval handler where
  eval = do
    x <- func
    rnf x `seq` return $! x

data Record = Record {
  myField :: Int
} deriving (Show)

iThrowExceptions :: Int
iThrowExceptions = error "Our Exception"

main :: IO ()
main = do
  val1 <- (do print "Technique 1" 
              return $ Just $ Record iThrowExceptions)
          `safeCatch`
          (\ e -> do print $ "We got it " ++ (show (e :: SomeException)) 
                     return Nothing)
  print val1  
  val2 <- (do print "Technique 2"
              return $ Just $ Record $ mapException (\e -> FieldAssignmentException "myField" (show (e :: SomeException))) iThrowExceptions)
  print "No Exception Yet. The assignment is still a thunk."
  (print val2) `catch` (\ e -> print $ "Now we have our exception " ++ (show (e :: SomeException)))  
 
$(deriveNFData ''Record)