module Safe.Failure (
Safe.Failure.head, Safe.Failure.tail,
Safe.Failure.init, Safe.Failure.last,
Safe.Failure.minimum, Safe.Failure.maximum,
Safe.Failure.foldr1, Safe.Failure.foldl1,
Safe.Failure.at, Safe.Failure.lookup,
Safe.Failure.fromJust,
Safe.Failure.read,
def, note,
SafeException(..),
HeadFailure(..), TailFailure(..), InitFailure(..), LastFailure(..),
MaximumFailure(..), MinimumFailure(..),
Foldl1Failure(..), Foldr1Failure(..),
IndexFailure(..), LookupFailure(..),
FromJustFailure(..),
ReadFailure(..),
) where
import Control.Exception
import Control.Monad.Failure
import Data.Maybe
import Data.Typeable
#ifdef CME
import Control.Monad.Exception.Throws
#endif
def :: a -> Maybe a -> a
def v = fromMaybe v
note :: Exception e => String -> Either e a -> a
note msg = either (\e -> error (show e ++ ": " ++ msg)) id
data SafeException = forall e. Exception e => SafeException e
deriving (Typeable)
instance Show SafeException where
showsPrec p (SafeException e) = ("Safe Exception:" ++) . showsPrec p e
instance Exception SafeException
safeExceptionToException :: Exception e => e -> SomeException
safeExceptionToException = toException . SafeException
safeExceptionFromException :: Exception e => SomeException -> Maybe e
safeExceptionFromException e = do { SafeException e' <- fromException e; cast e'}
liftFailure :: MonadFailure e m => (a -> Bool) -> e -> (a -> b) -> a -> m b
liftFailure test e f val = if test val then failure e else return (f val)
data TailFailure = TailFailure deriving (Show,Typeable)
instance Exception TailFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
tail :: MonadFailure TailFailure m => [a] -> m [a]
tail = liftFailure null TailFailure Prelude.tail
data InitFailure = InitFailure deriving (Show,Typeable)
instance Exception InitFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
init :: MonadFailure InitFailure m => [a] -> m [a]
init = liftFailure null InitFailure Prelude.init
data HeadFailure = HeadFailure deriving (Show,Typeable)
instance Exception HeadFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
head :: MonadFailure HeadFailure m => [a] -> m a
head = liftFailure null HeadFailure Prelude.head
data LastFailure = LastFailure deriving (Show,Typeable)
instance Exception LastFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
last :: MonadFailure LastFailure m => [a] -> m a
last = liftFailure null LastFailure Prelude.last
data MinimumFailure = MinimumFailure deriving (Show,Typeable)
instance Exception MinimumFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
minimum :: (Ord a, MonadFailure MinimumFailure m) => [a] -> m a
minimum = liftFailure null MinimumFailure Prelude.minimum
data MaximumFailure = MaximumFailure deriving (Show,Typeable)
instance Exception MaximumFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
maximum :: (Ord a, MonadFailure MaximumFailure m) => [a] -> m a
maximum = liftFailure null MaximumFailure Prelude.maximum
data Foldr1Failure = Foldr1Failure deriving (Show,Typeable)
instance Exception Foldr1Failure where
fromException = safeExceptionFromException
toException = safeExceptionToException
foldr1 :: MonadFailure Foldr1Failure m => (a -> a -> a) -> [a] -> m a
foldr1 f = liftFailure null Foldr1Failure (Prelude.foldr1 f)
data Foldl1Failure = Foldl1Failure deriving (Show,Typeable)
instance Exception Foldl1Failure where
fromException = safeExceptionFromException
toException = safeExceptionToException
foldl1 :: MonadFailure Foldl1Failure m => (a -> a -> a) -> [a] -> m a
foldl1 f = liftFailure null Foldl1Failure (Prelude.foldl1 f)
data FromJustFailure = FromJustFailure deriving (Show,Typeable)
instance Exception FromJustFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
fromJust :: MonadFailure FromJustFailure m => Maybe a -> m a
fromJust = liftFailure isNothing FromJustFailure Data.Maybe.fromJust
data IndexFailure = IndexFailure Int deriving (Show,Typeable)
instance Exception IndexFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
at :: MonadFailure IndexFailure m => [a] -> Int -> m a
at xs n
| n < 0 = failure (IndexFailure n)
| otherwise = go xs n
where
go [] _ = failure (IndexFailure n)
go (x:_) 0 = return x
go (_:xx) i = go xx (i1)
data ReadFailure = ReadFailure String deriving (Show,Typeable)
instance Exception ReadFailure where
fromException = safeExceptionFromException
toException = safeExceptionToException
read :: (Read a, MonadFailure ReadFailure m) => String -> m a
read s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> return x
_ -> failure (ReadFailure s)
data LookupFailure a = LookupFailure a deriving (Show,Typeable)
instance (Typeable a, Show a) => Exception (LookupFailure a) where
fromException = safeExceptionFromException
toException = safeExceptionToException
lookup :: (Eq a, MonadFailure (LookupFailure a) m) => a -> [(a,b)] -> m b
lookup key = maybe (failure (LookupFailure key)) return . Prelude.lookup key
#ifdef CME
instance Throws TailFailure (Caught SafeException l)
instance Throws HeadFailure (Caught SafeException l)
instance Throws InitFailure (Caught SafeException l)
instance Throws LastFailure (Caught SafeException l)
instance Throws MinimumFailure (Caught SafeException l)
instance Throws MaximumFailure (Caught SafeException l)
instance Throws Foldr1Failure (Caught SafeException l)
instance Throws Foldl1Failure (Caught SafeException l)
instance Throws FromJustFailure (Caught SafeException l)
instance Throws IndexFailure (Caught SafeException l)
instance Throws ReadFailure (Caught SafeException l)
instance (Typeable a, Show a) => Throws (LookupFailure a) (Caught SafeException l)
#endif