module System.ExceptionMailer
( exceptionMailerTag
, setupExceptionMailer, setupExceptionMailer', setupExceptionMailer_adv
, mkAddress
, mailError
, Address
) where
import Prelude hiding (catch)
import System.Environment (getProgName)
import Data.String (fromString)
import Data.Maybe
import qualified Data.Text.Lazy as LT
import Control.Exception (SomeException, catch)
import GHC.Conc (setUncaughtExceptionHandler)
import Network.Mail.Mime
import System.Log.Logger (errorM)
exceptionMailerTag :: String
exceptionMailerTag = "ExceptionMailer"
setupExceptionMailer :: Address
-> Address
-> Maybe String
-> String
-> IO ()
setupExceptionMailer from to subj pre =
setupExceptionMailer_adv from to subj pre (\_ -> return ())
setupExceptionMailer' :: String
-> String
-> Maybe String
-> String
-> IO ()
setupExceptionMailer' from to subj pre = setupExceptionMailer (Address Nothing $ fromString from) (Address Nothing $ fromString to) subj pre
setupExceptionMailer_adv :: Address
-> Address
-> Maybe String
-> String
-> (SomeException -> IO ())
-> IO ()
setupExceptionMailer_adv from to subj pre action =
setUncaughtExceptionHandler $ \e -> do
emailException from to subj pre e
action e
mkAddress :: String -> String -> Address
mkAddress name email = Address (Just $ fromString name) $ fromString email
mailError :: Address -> Address -> Maybe String -> String -> IO ()
mailError from to subj msg = do
prog <- getProgName
let m = simpleMail' to from (fromString $ fromMaybe "Exception Mailer" subj)
(LT.concat ["Program: ", fromString $ prog ++ "\n"
,"Exception:\n", fromString msg])
renderSendMail m
emailException :: Show a => Address -> Address -> Maybe String -> String -> a -> IO ()
emailException from to subj pre e = do
errorM exceptionMailerTag $ "Uncaught exception. emailing ("++
show (addressEmail to)++") : "++show e
catch (mailError from to subj (pre ++ show e))
(\e2 -> errorM exceptionMailerTag $ "Unable to send email : "++show (e2 :: SomeException))
return ()