{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE CPP                #-}

------------------------------------------------------------------------------
-- |
-- Module      :  Database.PostgreSQL.Simple.Ok
-- Copyright   :  (c) 2012-2015 Leon P Smith
-- License     :  BSD3
--
-- Maintainer  :  leon@melding-monads.com
-- Stability   :  experimental
--
-- The 'Ok' type is a simple error handler,  basically equivalent to
-- @Either [SomeException]@.   This type (without the list) was used to
-- handle conversion errors in early versions of postgresql-simple.
--
-- One of the primary reasons why this type  was introduced is that
-- @Either SomeException@ had not been provided an instance for 'Alternative',
-- and it would have been a bad idea to provide an orphaned instance for a
-- commonly-used type and typeclass included in @base@.
--
-- Extending the failure case to a list of 'SomeException's enables a
-- more sensible 'Alternative' instance definitions:   '<|>' concatenates
-- the list of exceptions when both cases fail,  and 'empty' is defined as
-- 'Errors []'.   Though '<|>' one could pick one of two exceptions, and
-- throw away the other,  and have 'empty' provide a generic exception,
-- this avoids cases where 'empty' overrides a more informative exception
-- and allows you to see all the different ways your computation has failed.
--
------------------------------------------------------------------------------

module Database.PostgreSQL.Simple.Ok where

import Control.Applicative
import Control.Exception
import Control.Monad(MonadPlus(..))
import Data.Typeable

import qualified Control.Monad.Fail as Fail

-- FIXME:   [SomeException] should probably be something else,  maybe
--          a difference list (or a tree?)

data Ok a = Errors [SomeException] | Ok !a
    deriving(Int -> Ok a -> ShowS
[Ok a] -> ShowS
Ok a -> String
(Int -> Ok a -> ShowS)
-> (Ok a -> String) -> ([Ok a] -> ShowS) -> Show (Ok a)
forall a. Show a => Int -> Ok a -> ShowS
forall a. Show a => [Ok a] -> ShowS
forall a. Show a => Ok a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ok a] -> ShowS
$cshowList :: forall a. Show a => [Ok a] -> ShowS
show :: Ok a -> String
$cshow :: forall a. Show a => Ok a -> String
showsPrec :: Int -> Ok a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ok a -> ShowS
Show, Typeable, a -> Ok b -> Ok a
(a -> b) -> Ok a -> Ok b
(forall a b. (a -> b) -> Ok a -> Ok b)
-> (forall a b. a -> Ok b -> Ok a) -> Functor Ok
forall a b. a -> Ok b -> Ok a
forall a b. (a -> b) -> Ok a -> Ok b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Ok b -> Ok a
$c<$ :: forall a b. a -> Ok b -> Ok a
fmap :: (a -> b) -> Ok a -> Ok b
$cfmap :: forall a b. (a -> b) -> Ok a -> Ok b
Functor)

-- | Two 'Errors' cases are considered equal, regardless of what the
--   list of exceptions looks like.

instance Eq a => Eq (Ok a) where
    Errors [SomeException]
_ == :: Ok a -> Ok a -> Bool
== Errors [SomeException]
_  = Bool
True
    Ok  a
a    == Ok  a
b     = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
    Ok a
_        == Ok a
_         = Bool
False

instance Applicative Ok where
    pure :: a -> Ok a
pure = a -> Ok a
forall a. a -> Ok a
Ok

    Errors [SomeException]
es <*> :: Ok (a -> b) -> Ok a -> Ok b
<*> Ok a
_ = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
es
    Ok (a -> b)
_ <*> Errors [SomeException]
es = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
es
    Ok a -> b
f <*> Ok a
a   = b -> Ok b
forall a. a -> Ok a
Ok (a -> b
f a
a)

instance Alternative Ok where
    empty :: Ok a
empty = [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors []

    a :: Ok a
a@(Ok a
_)  <|> :: Ok a -> Ok a -> Ok a
<|> Ok a
_         = Ok a
a
    Errors [SomeException]
_  <|> b :: Ok a
b@(Ok a
_)  = Ok a
b
    Errors [SomeException]
as <|> Errors [SomeException]
bs = [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors ([SomeException]
as [SomeException] -> [SomeException] -> [SomeException]
forall a. [a] -> [a] -> [a]
++ [SomeException]
bs)

instance MonadPlus Ok where
    mzero :: Ok a
mzero = Ok a
forall (f :: * -> *) a. Alternative f => f a
empty
    mplus :: Ok a -> Ok a -> Ok a
mplus = Ok a -> Ok a -> Ok a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monad Ok where
#if !(MIN_VERSION_base(4,8,0))
    return = pure
#endif

    Errors [SomeException]
es >>= :: Ok a -> (a -> Ok b) -> Ok b
>>= a -> Ok b
_ = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
es
    Ok a
a      >>= a -> Ok b
f = a -> Ok b
f a
a

#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
#endif

instance Fail.MonadFail Ok where
    fail :: String -> Ok a
fail String
str = [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [ErrorCall -> SomeException
forall e. Exception e => e -> SomeException
SomeException (String -> ErrorCall
ErrorCall String
str)]

-- | a way to reify a list of exceptions into a single exception

newtype ManyErrors = ManyErrors [SomeException]
   deriving (Int -> ManyErrors -> ShowS
[ManyErrors] -> ShowS
ManyErrors -> String
(Int -> ManyErrors -> ShowS)
-> (ManyErrors -> String)
-> ([ManyErrors] -> ShowS)
-> Show ManyErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ManyErrors] -> ShowS
$cshowList :: [ManyErrors] -> ShowS
show :: ManyErrors -> String
$cshow :: ManyErrors -> String
showsPrec :: Int -> ManyErrors -> ShowS
$cshowsPrec :: Int -> ManyErrors -> ShowS
Show, Typeable)

instance Exception ManyErrors