{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}

---------------------------------------------------------
--
-- Module        : Data.Attempt
-- Copyright     : Michael Snoyman
-- License       : BSD3
--
-- Maintainer    : Michael Snoyman <michael@snoyman.com>
-- Stability     : Unstable
-- Portability   : portable
--
-- A universal data type for computations which may fail.
---------------------------------------------------------

-- | A universal data type for computations which may fail. Errors are reported
-- using extensible exceptions. These exceptions are not explicitly stated; if
-- you want this kind of functionality, something like control-monad-exception
-- might be a more appropriate fit.
module Data.Attempt
    ( -- * Data type and type class
      Attempt (..)
    , FromAttempt (..)
    , fa
    , joinAttempt
      -- * General handling of 'Attempt's
    , attempt
    , makeHandler
    , AttemptHandler (..)
      -- * Individual 'Attempt's
    , isFailure
    , isSuccess
    , fromSuccess
      -- * Lists of 'Attempt's
    , successes
    , failures
    , partitionAttempts
      -- * Runtime exceptions
    , attemptIO
      -- * Reexport the 'Failure' class
    , module Control.Failure
    ) where

import qualified Control.Exception as E
import Control.Monad (ap)
import Control.Applicative
import Data.Data
import Data.Either (lefts)
import Control.Failure
import GHC.Show (appPrec, appPrec1)
-- | Contains either a 'Success' value or a 'Failure' exception.
data Attempt v
  = Success v
  | forall e. E.Exception e => Failure e
    deriving (Typeable)

instance Show v => Show (Attempt v) where
  showsPrec :: Int -> Attempt v -> ShowS
showsPrec p :: Int
p (Success v :: v
v)
    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "Success " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
appPrec1 v
v
  showsPrec p :: Int
p (Failure v :: e
v)
    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString "Failure " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> e -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
appPrec1 e
v

instance Functor Attempt where
    fmap :: (a -> b) -> Attempt a -> Attempt b
fmap f :: a -> b
f (Success v :: a
v) = b -> Attempt b
forall v. v -> Attempt v
Success (b -> Attempt b) -> b -> Attempt b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
v
    fmap _ (Failure e :: e
e) = e -> Attempt b
forall v e. Exception e => e -> Attempt v
Failure e
e
instance Applicative Attempt where
    pure :: a -> Attempt a
pure = a -> Attempt a
forall v. v -> Attempt v
Success
    <*> :: Attempt (a -> b) -> Attempt a -> Attempt b
(<*>) = Attempt (a -> b) -> Attempt a -> Attempt b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Attempt where
    return :: a -> Attempt a
return = a -> Attempt a
forall v. v -> Attempt v
Success
    (Success v :: a
v) >>= :: Attempt a -> (a -> Attempt b) -> Attempt b
>>= f :: a -> Attempt b
f = a -> Attempt b
f a
v
    (Failure e :: e
e) >>= _ = e -> Attempt b
forall v e. Exception e => e -> Attempt v
Failure e
e
instance E.Exception e => Failure e Attempt where
    failure :: e -> Attempt v
failure = e -> Attempt v
forall v e. Exception e => e -> Attempt v
Failure

-- | Any type which can be converted from an 'Attempt'. The included instances are your \"usual suspects\" for dealing with error handling. They include:
--
-- 'IO': For the IO instance, any exceptions in the 'Attempt' are thrown as
-- runtime exceptions.
--
-- 'Maybe': Returns 'Nothing' on 'Failure', or 'Just' on 'Success'.
--
-- List: Returns the empty list on 'Failure', or a singleton list on 'Success'.
--
-- 'Either' 'String': Returns 'Left' ('show' exception) on 'Failure', or 'Right' on
-- 'Success'.
--
-- 'Either' 'E.Exception': Returns 'Left' exception on 'Failure', or 'Right' on
-- 'Success'.
class FromAttempt a where
    fromAttempt :: Attempt v -> a v

-- | A shortcut for 'fromAttempt'.
fa :: FromAttempt a => Attempt v -> a v
fa :: Attempt v -> a v
fa = Attempt v -> a v
forall (a :: * -> *) v. FromAttempt a => Attempt v -> a v
fromAttempt

instance FromAttempt IO where
    fromAttempt :: Attempt v -> IO v
fromAttempt = (forall e. Exception e => e -> IO v)
-> (v -> IO v) -> Attempt v -> IO v
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt forall e. Exception e => e -> IO v
forall e a. Exception e => e -> IO a
E.throwIO v -> IO v
forall (m :: * -> *) a. Monad m => a -> m a
return
instance FromAttempt Maybe where
    fromAttempt :: Attempt v -> Maybe v
fromAttempt = (forall e. Exception e => e -> Maybe v)
-> (v -> Maybe v) -> Attempt v -> Maybe v
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt (Maybe v -> e -> Maybe v
forall a b. a -> b -> a
const Maybe v
forall a. Maybe a
Nothing) v -> Maybe v
forall a. a -> Maybe a
Just
instance FromAttempt [] where
    fromAttempt :: Attempt v -> [v]
fromAttempt = (forall e. Exception e => e -> [v])
-> (v -> [v]) -> Attempt v -> [v]
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt ([v] -> e -> [v]
forall a b. a -> b -> a
const []) (v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [])
instance FromAttempt (Either String) where
    fromAttempt :: Attempt v -> Either String v
fromAttempt = (forall e. Exception e => e -> Either String v)
-> (v -> Either String v) -> Attempt v -> Either String v
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt (String -> Either String v
forall a b. a -> Either a b
Left (String -> Either String v)
-> (e -> String) -> e -> Either String v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show) v -> Either String v
forall a b. b -> Either a b
Right
instance FromAttempt (Either E.SomeException) where
    fromAttempt :: Attempt v -> Either SomeException v
fromAttempt = (forall e. Exception e => e -> Either SomeException v)
-> (v -> Either SomeException v)
-> Attempt v
-> Either SomeException v
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt (SomeException -> Either SomeException v
forall a b. a -> Either a b
Left (SomeException -> Either SomeException v)
-> (e -> SomeException) -> e -> Either SomeException v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
E.toException) v -> Either SomeException v
forall a b. b -> Either a b
Right

-- | This is not a simple translation of the Control.Monad.join function.
-- Instead, for 'Monad's which are instances of 'FromAttempt', it removes the
-- inner 'Attempt' type, reporting errors as defined in the 'FromAttempt'
-- instance.
--
-- For example, join (Just (failureString \"foo\")) == Nothing.
joinAttempt :: (FromAttempt m, Monad m) => m (Attempt v) -> m v
joinAttempt :: m (Attempt v) -> m v
joinAttempt = (m (Attempt v) -> (Attempt v -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Attempt v -> m v
forall (a :: * -> *) v. FromAttempt a => Attempt v -> a v
fromAttempt)

-- | Process either the exception or value in an 'Attempt' to produce a result.
--
-- This function is modeled after 'maybe' and 'either'. The first argument must
-- accept any instances of 'E.Exception'. If you want to handle multiple types
-- of exceptions, see 'makeHandler'. The second argument converts the success
-- value.
--
-- Note that this function does not expose all the data available in an
-- 'Attempt' value. Notably, the monadic stack trace is not passed on to the
-- error handler. If desired, use the 'monadicStackTrace' function to extract
-- it.
attempt :: (forall e. E.Exception e => e -> b) -- ^ error handler
        -> (a -> b) -- ^ success handler
        -> Attempt a
        -> b
attempt :: (forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt _ f :: a -> b
f (Success v :: a
v) = a -> b
f a
v
attempt f :: forall e. Exception e => e -> b
f _ (Failure e :: e
e) = e -> b
forall e. Exception e => e -> b
f e
e

-- | Convert multiple 'AttemptHandler's and a default value into an exception
-- handler.
--
-- This is a convenience function when you want to have special handling for a
-- few types of 'E.Exception's and provide another value for anything else.
makeHandler :: [AttemptHandler v]
            -> v
            -> (forall e. E.Exception e => e -> v)
makeHandler :: [AttemptHandler v] -> v -> forall e. Exception e => e -> v
makeHandler [] v :: v
v _ = v
v
makeHandler (AttemptHandler h :: e -> v
h:hs :: [AttemptHandler v]
hs) v :: v
v e :: e
e =
    case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
E.fromException (e -> SomeException
forall e. Exception e => e -> SomeException
E.toException e
e) of
        Just e' :: e
e' -> e -> v
h e
e'
        Nothing -> [AttemptHandler v] -> v -> e -> v
forall v.
[AttemptHandler v] -> v -> forall e. Exception e => e -> v
makeHandler [AttemptHandler v]
hs v
v e
e

-- | A simple wrapper value necesary due to the Haskell type system. Wraps a
-- function from a *specific* 'E.Exception' type to some value.
data AttemptHandler v = forall e. E.Exception e => AttemptHandler (e -> v)

-- | Tests for a 'Failure' value.
isFailure :: Attempt v -> Bool
isFailure :: Attempt v -> Bool
isFailure = (forall e. Exception e => e -> Bool)
-> (v -> Bool) -> Attempt v -> Bool
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt (Bool -> e -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> v -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | Tests for a 'Success' value.
isSuccess :: Attempt v -> Bool
isSuccess :: Attempt v -> Bool
isSuccess = (forall e. Exception e => e -> Bool)
-> (v -> Bool) -> Attempt v -> Bool
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt (Bool -> e -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> v -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | This is an unsafe, partial function which should only be used if you
-- either know that a function will succeed or don't mind the occassional
-- runtime exception.
fromSuccess :: Attempt v -> v
fromSuccess :: Attempt v -> v
fromSuccess = (forall e. Exception e => e -> v) -> (v -> v) -> Attempt v -> v
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt (String -> v
forall a. HasCallStack => String -> a
error (String -> v) -> (e -> String) -> e -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show) v -> v
forall a. a -> a
id

-- | Returns only the 'Success' values.
successes :: [Attempt v] -> [v]
successes :: [Attempt v] -> [v]
successes l :: [Attempt v]
l = [ v
v | Success v :: v
v <- [Attempt v]
l ]

-- | Returns only the 'Failure' values, each wrapped in a 'SomeException'.
failures :: [Attempt v] -> [E.SomeException]
failures :: [Attempt v] -> [SomeException]
failures = [Either SomeException v] -> [SomeException]
forall a b. [Either a b] -> [a]
lefts ([Either SomeException v] -> [SomeException])
-> ([Attempt v] -> [Either SomeException v])
-> [Attempt v]
-> [SomeException]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attempt v -> Either SomeException v)
-> [Attempt v] -> [Either SomeException v]
forall a b. (a -> b) -> [a] -> [b]
map Attempt v -> Either SomeException v
forall v. Attempt v -> Either SomeException v
eitherExceptionFromAttempt where
    eitherExceptionFromAttempt :: Attempt v -> Either E.SomeException v
    eitherExceptionFromAttempt :: Attempt v -> Either SomeException v
eitherExceptionFromAttempt = Attempt v -> Either SomeException v
forall (a :: * -> *) v. FromAttempt a => Attempt v -> a v
fa

-- | Return all of the 'Failure's and 'Success'es separately in a tuple.
partitionAttempts :: [Attempt v] -> ([E.SomeException], [v])
partitionAttempts :: [Attempt v] -> ([SomeException], [v])
partitionAttempts =
    (Attempt v -> ([SomeException], [v]) -> ([SomeException], [v]))
-> ([SomeException], [v]) -> [Attempt v] -> ([SomeException], [v])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall e.
 Exception e =>
 e -> ([SomeException], [v]) -> ([SomeException], [v]))
-> (v -> ([SomeException], [v]) -> ([SomeException], [v]))
-> Attempt v
-> ([SomeException], [v])
-> ([SomeException], [v])
forall b a.
(forall e. Exception e => e -> b) -> (a -> b) -> Attempt a -> b
attempt forall e.
Exception e =>
e -> ([SomeException], [v]) -> ([SomeException], [v])
forall e v.
Exception e =>
e -> ([SomeException], [v]) -> ([SomeException], [v])
f v -> ([SomeException], [v]) -> ([SomeException], [v])
forall a a. a -> (a, [a]) -> (a, [a])
s) ([],[])
  where
    f :: E.Exception e
      => e
      -> ([E.SomeException], [v])
      -> ([E.SomeException], [v])
    f :: e -> ([SomeException], [v]) -> ([SomeException], [v])
f a :: e
a (l :: [SomeException]
l, r :: [v]
r) = (e -> SomeException
forall e. Exception e => e -> SomeException
E.toException e
aSomeException -> [SomeException] -> [SomeException]
forall a. a -> [a] -> [a]
:[SomeException]
l, [v]
r)
    s :: a -> (a, [a]) -> (a, [a])
s a :: a
a (l :: a
l, r :: [a]
r) = (a
l, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)

-- | Catches runtime (ie, IO) exceptions and inserts them into an 'Attempt'.
--
-- Like 'handle', the first argument to this function must explicitly state the
-- type of its input.
attemptIO :: (E.Exception eIn, E.Exception eOut)
          => (eIn -> eOut)
          -> IO v
          -> IO (Attempt v)
attemptIO :: (eIn -> eOut) -> IO v -> IO (Attempt v)
attemptIO f :: eIn -> eOut
f =
      (eIn -> IO (Attempt v)) -> IO (Attempt v) -> IO (Attempt v)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (Attempt v -> IO (Attempt v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Attempt v -> IO (Attempt v))
-> (eIn -> Attempt v) -> eIn -> IO (Attempt v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. eOut -> Attempt v
forall v e. Exception e => e -> Attempt v
Failure (eOut -> Attempt v) -> (eIn -> eOut) -> eIn -> Attempt v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. eIn -> eOut
f)
    (IO (Attempt v) -> IO (Attempt v))
-> (IO v -> IO (Attempt v)) -> IO v -> IO (Attempt v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Attempt v) -> IO v -> IO (Attempt v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Attempt v
forall v. v -> Attempt v
Success