Ok.hs

------------------------------------------------------------------------------

------------------------------------------------------------------------------

-- |
-- 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 hpgsql-simple-compat.
--
-- 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 (Show, Typeable, Functor)

-- | Two 'Errors' cases are considered equal, regardless of what the
--   list of exceptions looks like.
instance (Eq a) => Eq (Ok a) where
  Errors _ == Errors _ = True
  Ok a == Ok b = a == b
  _ == _ = False

instance Applicative Ok where
  pure = Ok

  Errors es <*> _ = Errors es
  _ <*> Errors es = Errors es
  Ok f <*> Ok a = Ok (f a)

instance Alternative Ok where
  empty = Errors []

  a@(Ok _) <|> _ = a
  Errors _ <|> b@(Ok _) = b
  Errors as <|> Errors bs = Errors (as ++ bs)

instance MonadPlus Ok where
  mzero = empty
  mplus = (<|>)

instance Monad Ok where
  Errors es >>= _ = Errors es
  Ok a >>= f = f a

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

instance Fail.MonadFail Ok where
  fail str = Errors [SomeException (ErrorCall str)]

-- | a way to reify a list of exceptions into a single exception
newtype ManyErrors = ManyErrors [SomeException]
  deriving (Show, Typeable)

instance Exception ManyErrors