Some failure catching with the failure package

failure_test.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-# LANGUAGE DeriveDataTypeable #-}


import Control.Exception (Exception)
import Data.Typeable (Typeable)
import Control.Failure
import Control.Monad.Instances
import Data.Maybe


instance Failure e (Either e) where failure = Left


--our train exceptions
--with string error messages "collected" here
data TrainException = Train1Exception | Train2Exception deriving (Typeable)
instance Exception TrainException
instance Show TrainException where
    show Train1Exception = "train1"
    show Train2Exception = "train2"


--one possibility of catching an exception by binding it to Either
catcheithertest :: [Integer] -> IO ()
catcheithertest l = do
	x <- return $ listToB l
	case x of
		Left ex -> putStrLn $ show (ex :: TrainException)
		Right y -> putStrLn "aha"


--same as listToMaybe but polymorphic and returning TrainException
listToB :: Failure TrainException m => [a] -> m a
listToB [] = failure Train1Exception
listToB (a:_) = return a


--with try, maybe / [] or either returning functions can be transformed into a Failure
--[] will become NullException, Nothing a NothingException and an Either already holds the correct type
catchmaybetoeithertest :: [Integer] -> IO ()
catchmaybetoeithertest l = do
	x <- return $ (try . listToMaybe) l
	
	case x of
		Left ex -> putStrLn $ show (ex :: NothingException)
		Right x -> do
			putStr "right: "
			putStrLn $ show x

catchmaybetomaybetest :: [Integer] -> IO ()
catchmaybetomaybetest l = do
	x <- return $ (try . listToMaybe) l
	
	case x of
		Nothing -> putStrLn "nixN"
		Just x -> do
			putStr "just: "
			putStrLn $ show x