    {-# 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
    $cshowsPrec :: forall a. Show a => Int -> Ok a -> ShowS
    showsPrec :: Int -> Ok a -> ShowS
    $cshow :: forall a. Show a => Ok a -> String
    show :: Ok a -> String
    $cshowList :: forall a. Show a => [Ok a] -> ShowS
    showList :: [Ok a] -> ShowS
    Show, Typeable, (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
    $cfmap :: forall a b. (a -> b) -> Ok a -> Ok b
    fmap :: forall a b. (a -> b) -> Ok a -> Ok b
    $c<$ :: forall a b. a -> Ok b -> Ok a
    <$ :: forall a b. a -> Ok b -> Ok a
    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 :: forall a. a -> Ok a
    pure = a -> Ok a
    forall a. a -> Ok a
    Ok

        Errors [SomeException]
    es <*> :: forall a b. 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 :: forall a. Ok a
    empty = [SomeException] -> Ok a
    forall a. [SomeException] -> Ok a
    Errors []

        a :: Ok a
    a@(Ok a
    _)  <|> :: forall 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 :: forall a. Ok a
    mzero = Ok a
    forall a. Ok a
    forall (f :: * -> *) a. Alternative f => f a
    empty
        mplus :: forall a. Ok a -> Ok a -> Ok a
    mplus = Ok a -> Ok a -> Ok a
    forall a. Ok a -> Ok a -> Ok a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    (<|>)

    instance Monad Ok where
        Errors [SomeException]
    es >>= :: forall a b. 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 :: forall a. String -> Ok a
    fail String
    str = [SomeException] -> Ok a
    forall a. [SomeException] -> Ok a
    Errors [ErrorCall -> SomeException
    forall e. (Exception e, HasExceptionContext) => 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
    $cshowsPrec :: Int -> ManyErrors -> ShowS
    showsPrec :: Int -> ManyErrors -> ShowS
    $cshow :: ManyErrors -> String
    show :: ManyErrors -> String
    $cshowList :: [ManyErrors] -> ShowS
    showList :: [ManyErrors] -> ShowS
    Show, Typeable)

    instance Exception ManyErrors