{-# LANGUAGE ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Spoon
-- Copyright   :  © 2009 Matt Morrow & Dan Peebles, © 2013 Liyang HU
-- License     :  see LICENSE
-- 
-- Maintainer  :  spoon@liyang.hu
-- Stability   :  experimental
-- Portability :  non-portable (Scoped Type Variables)
--
-- Two functions for catching pureish exceptions in pure values. This library
-- considers pureish to be any error call or undefined, failed pattern matches,
-- arithmetic exceptions, and array bounds exceptions.
--
-----------------------------------------------------------------------------


module Control.Spoon
    ( Handles
    , spoon
    , spoonDefaultHandles
    , spoonWithHandles
    , teaspoon
    , teaspoonWithHandles
    ) where

import Control.Exception
import Control.DeepSeq
import System.IO.Unsafe

type Handles a = [Handler (Maybe a)]

{-# INLINEABLE spoonDefaultHandles #-}
spoonDefaultHandles :: Handles a
spoonDefaultHandles :: Handles a
spoonDefaultHandles =
    [ (ArithException -> IO (Maybe a)) -> Handler (Maybe a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((ArithException -> IO (Maybe a)) -> Handler (Maybe a))
-> (ArithException -> IO (Maybe a)) -> Handler (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(ArithException
_ :: ArithException)   -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    , (ArrayException -> IO (Maybe a)) -> Handler (Maybe a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((ArrayException -> IO (Maybe a)) -> Handler (Maybe a))
-> (ArrayException -> IO (Maybe a)) -> Handler (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(ArrayException
_ :: ArrayException)   -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    , (ErrorCall -> IO (Maybe a)) -> Handler (Maybe a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((ErrorCall -> IO (Maybe a)) -> Handler (Maybe a))
-> (ErrorCall -> IO (Maybe a)) -> Handler (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(ErrorCall
_ :: ErrorCall)        -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    , (PatternMatchFail -> IO (Maybe a)) -> Handler (Maybe a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((PatternMatchFail -> IO (Maybe a)) -> Handler (Maybe a))
-> (PatternMatchFail -> IO (Maybe a)) -> Handler (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(PatternMatchFail
_ :: PatternMatchFail) -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    , (SomeException -> IO (Maybe a)) -> Handler (Maybe a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO (Maybe a)) -> Handler (Maybe a))
-> (SomeException -> IO (Maybe a)) -> Handler (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(SomeException
x :: SomeException)    -> SomeException -> IO (Maybe a)
forall e a. Exception e => e -> IO a
throwIO SomeException
x ]

-- | Evaluate a value to normal form and return Nothing if any exceptions are thrown during evaluation. For any error-free value, @spoon = Just@.
{-# INLINEABLE spoonWithHandles #-}
spoonWithHandles :: NFData a => Handles a -> a -> Maybe a
spoonWithHandles :: Handles a -> a -> Maybe a
spoonWithHandles Handles a
handles a
a = IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafePerformIO (IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$
    a -> IO (Maybe a) -> IO (Maybe a)
forall a b. NFData a => a -> b -> b
deepseq a
a (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a) IO (Maybe a) -> Handles a -> IO (Maybe a)
forall a. IO a -> [Handler a] -> IO a
`catches` Handles a
handles

-- | Evaluate a value to normal form and return Nothing if any exceptions are thrown during evaluation. For any error-free value, @spoon = Just@.
{-# INLINE spoon #-}
spoon :: NFData a => a -> Maybe a
spoon :: a -> Maybe a
spoon = Handles a -> a -> Maybe a
forall a. NFData a => Handles a -> a -> Maybe a
spoonWithHandles Handles a
forall a. Handles a
spoonDefaultHandles

{-# INLINEABLE teaspoonWithHandles #-}
teaspoonWithHandles :: Handles a -> a -> Maybe a
teaspoonWithHandles :: Handles a -> a -> Maybe a
teaspoonWithHandles Handles a
handles a
a = IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafePerformIO (IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$
    (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` a -> IO a
forall a. a -> IO a
evaluate a
a) IO (Maybe a) -> Handles a -> IO (Maybe a)
forall a. IO a -> [Handler a] -> IO a
`catches` Handles a
handles

-- | Like 'spoon', but only evaluates to WHNF.
{-# INLINE teaspoon #-}
teaspoon :: a -> Maybe a
teaspoon :: a -> Maybe a
teaspoon = Handles a -> a -> Maybe a
forall a. Handles a -> a -> Maybe a
teaspoonWithHandles Handles a
forall a. Handles a
spoonDefaultHandles