-- | Definitions of exception types.
module Database.PostgreSQL.PQTypes.Internal.Error (
    DetailedQueryError(..)
  , QueryError(..)
  , HPQTypesError(..)
  , LibPQError(..)
  , ConversionError(..)
  , ArrayItemError(..)
  , InvalidValue(..)
  , RangeError(..)
  , ArrayDimensionMismatch(..)
  , RowLengthMismatch(..)
  , AffectedRowsMismatch(..)
  ) where

import Data.Typeable
import qualified Control.Exception as E

import Database.PostgreSQL.PQTypes.Internal.Error.Code

-- | SQL query error. Reference: description of PQresultErrorField
-- at <http://www.postgresql.org/docs/devel/static/libpq-exec.html>.
data DetailedQueryError = DetailedQueryError
  { DetailedQueryError -> String
qeSeverity          :: !String
  , DetailedQueryError -> ErrorCode
qeErrorCode         :: !ErrorCode
  , DetailedQueryError -> String
qeMessagePrimary    :: !String
  , DetailedQueryError -> Maybe String
qeMessageDetail     :: !(Maybe String)
  , DetailedQueryError -> Maybe String
qeMessageHint       :: !(Maybe String)
  , DetailedQueryError -> Maybe Int
qeStatementPosition :: !(Maybe Int)
  , DetailedQueryError -> Maybe Int
qeInternalPosition  :: !(Maybe Int)
  , DetailedQueryError -> Maybe String
qeInternalQuery     :: !(Maybe String)
  , DetailedQueryError -> Maybe String
qeContext           :: !(Maybe String)
  , DetailedQueryError -> Maybe String
qeSourceFile        :: !(Maybe String)
  , DetailedQueryError -> Maybe Int
qeSourceLine        :: !(Maybe Int)
  , DetailedQueryError -> Maybe String
qeSourceFunction    :: !(Maybe String)
  } deriving (DetailedQueryError -> DetailedQueryError -> Bool
(DetailedQueryError -> DetailedQueryError -> Bool)
-> (DetailedQueryError -> DetailedQueryError -> Bool)
-> Eq DetailedQueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetailedQueryError -> DetailedQueryError -> Bool
$c/= :: DetailedQueryError -> DetailedQueryError -> Bool
== :: DetailedQueryError -> DetailedQueryError -> Bool
$c== :: DetailedQueryError -> DetailedQueryError -> Bool
Eq, Eq DetailedQueryError
Eq DetailedQueryError
-> (DetailedQueryError -> DetailedQueryError -> Ordering)
-> (DetailedQueryError -> DetailedQueryError -> Bool)
-> (DetailedQueryError -> DetailedQueryError -> Bool)
-> (DetailedQueryError -> DetailedQueryError -> Bool)
-> (DetailedQueryError -> DetailedQueryError -> Bool)
-> (DetailedQueryError -> DetailedQueryError -> DetailedQueryError)
-> (DetailedQueryError -> DetailedQueryError -> DetailedQueryError)
-> Ord DetailedQueryError
DetailedQueryError -> DetailedQueryError -> Bool
DetailedQueryError -> DetailedQueryError -> Ordering
DetailedQueryError -> DetailedQueryError -> DetailedQueryError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DetailedQueryError -> DetailedQueryError -> DetailedQueryError
$cmin :: DetailedQueryError -> DetailedQueryError -> DetailedQueryError
max :: DetailedQueryError -> DetailedQueryError -> DetailedQueryError
$cmax :: DetailedQueryError -> DetailedQueryError -> DetailedQueryError
>= :: DetailedQueryError -> DetailedQueryError -> Bool
$c>= :: DetailedQueryError -> DetailedQueryError -> Bool
> :: DetailedQueryError -> DetailedQueryError -> Bool
$c> :: DetailedQueryError -> DetailedQueryError -> Bool
<= :: DetailedQueryError -> DetailedQueryError -> Bool
$c<= :: DetailedQueryError -> DetailedQueryError -> Bool
< :: DetailedQueryError -> DetailedQueryError -> Bool
$c< :: DetailedQueryError -> DetailedQueryError -> Bool
compare :: DetailedQueryError -> DetailedQueryError -> Ordering
$ccompare :: DetailedQueryError -> DetailedQueryError -> Ordering
$cp1Ord :: Eq DetailedQueryError
Ord, Int -> DetailedQueryError -> ShowS
[DetailedQueryError] -> ShowS
DetailedQueryError -> String
(Int -> DetailedQueryError -> ShowS)
-> (DetailedQueryError -> String)
-> ([DetailedQueryError] -> ShowS)
-> Show DetailedQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetailedQueryError] -> ShowS
$cshowList :: [DetailedQueryError] -> ShowS
show :: DetailedQueryError -> String
$cshow :: DetailedQueryError -> String
showsPrec :: Int -> DetailedQueryError -> ShowS
$cshowsPrec :: Int -> DetailedQueryError -> ShowS
Show)

-- | Simple SQL query error. Thrown when there is no
-- PGresult object corresponding to query execution.
newtype QueryError = QueryError String
  deriving (QueryError -> QueryError -> Bool
(QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> Bool) -> Eq QueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryError -> QueryError -> Bool
$c/= :: QueryError -> QueryError -> Bool
== :: QueryError -> QueryError -> Bool
$c== :: QueryError -> QueryError -> Bool
Eq, Eq QueryError
Eq QueryError
-> (QueryError -> QueryError -> Ordering)
-> (QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> QueryError)
-> (QueryError -> QueryError -> QueryError)
-> Ord QueryError
QueryError -> QueryError -> Bool
QueryError -> QueryError -> Ordering
QueryError -> QueryError -> QueryError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QueryError -> QueryError -> QueryError
$cmin :: QueryError -> QueryError -> QueryError
max :: QueryError -> QueryError -> QueryError
$cmax :: QueryError -> QueryError -> QueryError
>= :: QueryError -> QueryError -> Bool
$c>= :: QueryError -> QueryError -> Bool
> :: QueryError -> QueryError -> Bool
$c> :: QueryError -> QueryError -> Bool
<= :: QueryError -> QueryError -> Bool
$c<= :: QueryError -> QueryError -> Bool
< :: QueryError -> QueryError -> Bool
$c< :: QueryError -> QueryError -> Bool
compare :: QueryError -> QueryError -> Ordering
$ccompare :: QueryError -> QueryError -> Ordering
$cp1Ord :: Eq QueryError
Ord, Int -> QueryError -> ShowS
[QueryError] -> ShowS
QueryError -> String
(Int -> QueryError -> ShowS)
-> (QueryError -> String)
-> ([QueryError] -> ShowS)
-> Show QueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryError] -> ShowS
$cshowList :: [QueryError] -> ShowS
show :: QueryError -> String
$cshow :: QueryError -> String
showsPrec :: Int -> QueryError -> ShowS
$cshowsPrec :: Int -> QueryError -> ShowS
Show)

-- | Internal error in this library.
newtype HPQTypesError = HPQTypesError String
  deriving (HPQTypesError -> HPQTypesError -> Bool
(HPQTypesError -> HPQTypesError -> Bool)
-> (HPQTypesError -> HPQTypesError -> Bool) -> Eq HPQTypesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HPQTypesError -> HPQTypesError -> Bool
$c/= :: HPQTypesError -> HPQTypesError -> Bool
== :: HPQTypesError -> HPQTypesError -> Bool
$c== :: HPQTypesError -> HPQTypesError -> Bool
Eq, Eq HPQTypesError
Eq HPQTypesError
-> (HPQTypesError -> HPQTypesError -> Ordering)
-> (HPQTypesError -> HPQTypesError -> Bool)
-> (HPQTypesError -> HPQTypesError -> Bool)
-> (HPQTypesError -> HPQTypesError -> Bool)
-> (HPQTypesError -> HPQTypesError -> Bool)
-> (HPQTypesError -> HPQTypesError -> HPQTypesError)
-> (HPQTypesError -> HPQTypesError -> HPQTypesError)
-> Ord HPQTypesError
HPQTypesError -> HPQTypesError -> Bool
HPQTypesError -> HPQTypesError -> Ordering
HPQTypesError -> HPQTypesError -> HPQTypesError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HPQTypesError -> HPQTypesError -> HPQTypesError
$cmin :: HPQTypesError -> HPQTypesError -> HPQTypesError
max :: HPQTypesError -> HPQTypesError -> HPQTypesError
$cmax :: HPQTypesError -> HPQTypesError -> HPQTypesError
>= :: HPQTypesError -> HPQTypesError -> Bool
$c>= :: HPQTypesError -> HPQTypesError -> Bool
> :: HPQTypesError -> HPQTypesError -> Bool
$c> :: HPQTypesError -> HPQTypesError -> Bool
<= :: HPQTypesError -> HPQTypesError -> Bool
$c<= :: HPQTypesError -> HPQTypesError -> Bool
< :: HPQTypesError -> HPQTypesError -> Bool
$c< :: HPQTypesError -> HPQTypesError -> Bool
compare :: HPQTypesError -> HPQTypesError -> Ordering
$ccompare :: HPQTypesError -> HPQTypesError -> Ordering
$cp1Ord :: Eq HPQTypesError
Ord, Int -> HPQTypesError -> ShowS
[HPQTypesError] -> ShowS
HPQTypesError -> String
(Int -> HPQTypesError -> ShowS)
-> (HPQTypesError -> String)
-> ([HPQTypesError] -> ShowS)
-> Show HPQTypesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HPQTypesError] -> ShowS
$cshowList :: [HPQTypesError] -> ShowS
show :: HPQTypesError -> String
$cshow :: HPQTypesError -> String
showsPrec :: Int -> HPQTypesError -> ShowS
$cshowsPrec :: Int -> HPQTypesError -> ShowS
Show)

-- | Internal error in libpq/libpqtypes library.
newtype LibPQError = LibPQError String
  deriving (LibPQError -> LibPQError -> Bool
(LibPQError -> LibPQError -> Bool)
-> (LibPQError -> LibPQError -> Bool) -> Eq LibPQError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibPQError -> LibPQError -> Bool
$c/= :: LibPQError -> LibPQError -> Bool
== :: LibPQError -> LibPQError -> Bool
$c== :: LibPQError -> LibPQError -> Bool
Eq, Eq LibPQError
Eq LibPQError
-> (LibPQError -> LibPQError -> Ordering)
-> (LibPQError -> LibPQError -> Bool)
-> (LibPQError -> LibPQError -> Bool)
-> (LibPQError -> LibPQError -> Bool)
-> (LibPQError -> LibPQError -> Bool)
-> (LibPQError -> LibPQError -> LibPQError)
-> (LibPQError -> LibPQError -> LibPQError)
-> Ord LibPQError
LibPQError -> LibPQError -> Bool
LibPQError -> LibPQError -> Ordering
LibPQError -> LibPQError -> LibPQError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LibPQError -> LibPQError -> LibPQError
$cmin :: LibPQError -> LibPQError -> LibPQError
max :: LibPQError -> LibPQError -> LibPQError
$cmax :: LibPQError -> LibPQError -> LibPQError
>= :: LibPQError -> LibPQError -> Bool
$c>= :: LibPQError -> LibPQError -> Bool
> :: LibPQError -> LibPQError -> Bool
$c> :: LibPQError -> LibPQError -> Bool
<= :: LibPQError -> LibPQError -> Bool
$c<= :: LibPQError -> LibPQError -> Bool
< :: LibPQError -> LibPQError -> Bool
$c< :: LibPQError -> LibPQError -> Bool
compare :: LibPQError -> LibPQError -> Ordering
$ccompare :: LibPQError -> LibPQError -> Ordering
$cp1Ord :: Eq LibPQError
Ord, Int -> LibPQError -> ShowS
[LibPQError] -> ShowS
LibPQError -> String
(Int -> LibPQError -> ShowS)
-> (LibPQError -> String)
-> ([LibPQError] -> ShowS)
-> Show LibPQError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibPQError] -> ShowS
$cshowList :: [LibPQError] -> ShowS
show :: LibPQError -> String
$cshow :: LibPQError -> String
showsPrec :: Int -> LibPQError -> ShowS
$cshowsPrec :: Int -> LibPQError -> ShowS
Show)

-- | Data conversion error. Since it's polymorphic in error type,
-- it nicely reports arbitrarily nested conversion errors.
data ConversionError = forall e. E.Exception e => ConversionError
  { -- | Column number (Starts with 1).
    ConversionError -> Int
convColumn     :: !Int
    -- | Name of the column.
  , ConversionError -> String
convColumnName :: !String
    -- | Row number (Starts with 1).
  , ConversionError -> Int
convRow        :: !Int
    -- | Exact error.
  , ()
convError      :: !e
  }

deriving instance Show ConversionError

-- | Array item error. Polymorphic in error type
-- for the same reason as 'ConversionError'.
data ArrayItemError = forall e. E.Exception e => ArrayItemError
  { -- | Item index (Starts with 1).
    ArrayItemError -> Int
arrItemIndex :: !Int
    -- | Exact error.
  , ()
arrItemError :: !e
}

deriving instance Show ArrayItemError

-- | \"Invalid value\" error for various data types.
data InvalidValue t = InvalidValue
  { -- | Invalid value.
    InvalidValue t -> t
ivValue       :: t
    -- Optional list of valid values.
  , InvalidValue t -> Maybe [t]
ivValidValues :: Maybe [t]
  } deriving (InvalidValue t -> InvalidValue t -> Bool
(InvalidValue t -> InvalidValue t -> Bool)
-> (InvalidValue t -> InvalidValue t -> Bool)
-> Eq (InvalidValue t)
forall t. Eq t => InvalidValue t -> InvalidValue t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidValue t -> InvalidValue t -> Bool
$c/= :: forall t. Eq t => InvalidValue t -> InvalidValue t -> Bool
== :: InvalidValue t -> InvalidValue t -> Bool
$c== :: forall t. Eq t => InvalidValue t -> InvalidValue t -> Bool
Eq, Eq (InvalidValue t)
Eq (InvalidValue t)
-> (InvalidValue t -> InvalidValue t -> Ordering)
-> (InvalidValue t -> InvalidValue t -> Bool)
-> (InvalidValue t -> InvalidValue t -> Bool)
-> (InvalidValue t -> InvalidValue t -> Bool)
-> (InvalidValue t -> InvalidValue t -> Bool)
-> (InvalidValue t -> InvalidValue t -> InvalidValue t)
-> (InvalidValue t -> InvalidValue t -> InvalidValue t)
-> Ord (InvalidValue t)
InvalidValue t -> InvalidValue t -> Bool
InvalidValue t -> InvalidValue t -> Ordering
InvalidValue t -> InvalidValue t -> InvalidValue t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (InvalidValue t)
forall t. Ord t => InvalidValue t -> InvalidValue t -> Bool
forall t. Ord t => InvalidValue t -> InvalidValue t -> Ordering
forall t.
Ord t =>
InvalidValue t -> InvalidValue t -> InvalidValue t
min :: InvalidValue t -> InvalidValue t -> InvalidValue t
$cmin :: forall t.
Ord t =>
InvalidValue t -> InvalidValue t -> InvalidValue t
max :: InvalidValue t -> InvalidValue t -> InvalidValue t
$cmax :: forall t.
Ord t =>
InvalidValue t -> InvalidValue t -> InvalidValue t
>= :: InvalidValue t -> InvalidValue t -> Bool
$c>= :: forall t. Ord t => InvalidValue t -> InvalidValue t -> Bool
> :: InvalidValue t -> InvalidValue t -> Bool
$c> :: forall t. Ord t => InvalidValue t -> InvalidValue t -> Bool
<= :: InvalidValue t -> InvalidValue t -> Bool
$c<= :: forall t. Ord t => InvalidValue t -> InvalidValue t -> Bool
< :: InvalidValue t -> InvalidValue t -> Bool
$c< :: forall t. Ord t => InvalidValue t -> InvalidValue t -> Bool
compare :: InvalidValue t -> InvalidValue t -> Ordering
$ccompare :: forall t. Ord t => InvalidValue t -> InvalidValue t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (InvalidValue t)
Ord, Int -> InvalidValue t -> ShowS
[InvalidValue t] -> ShowS
InvalidValue t -> String
(Int -> InvalidValue t -> ShowS)
-> (InvalidValue t -> String)
-> ([InvalidValue t] -> ShowS)
-> Show (InvalidValue t)
forall t. Show t => Int -> InvalidValue t -> ShowS
forall t. Show t => [InvalidValue t] -> ShowS
forall t. Show t => InvalidValue t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidValue t] -> ShowS
$cshowList :: forall t. Show t => [InvalidValue t] -> ShowS
show :: InvalidValue t -> String
$cshow :: forall t. Show t => InvalidValue t -> String
showsPrec :: Int -> InvalidValue t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> InvalidValue t -> ShowS
Show)

-- | Range error for various data types.
data RangeError t = RangeError
  { -- | Allowed range (sum of acceptable ranges).
    RangeError t -> [(t, t)]
reRange :: [(t, t)]
    -- | Provided value which is not in above range.
  , RangeError t -> t
reValue :: t
  } deriving (RangeError t -> RangeError t -> Bool
(RangeError t -> RangeError t -> Bool)
-> (RangeError t -> RangeError t -> Bool) -> Eq (RangeError t)
forall t. Eq t => RangeError t -> RangeError t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RangeError t -> RangeError t -> Bool
$c/= :: forall t. Eq t => RangeError t -> RangeError t -> Bool
== :: RangeError t -> RangeError t -> Bool
$c== :: forall t. Eq t => RangeError t -> RangeError t -> Bool
Eq, Eq (RangeError t)
Eq (RangeError t)
-> (RangeError t -> RangeError t -> Ordering)
-> (RangeError t -> RangeError t -> Bool)
-> (RangeError t -> RangeError t -> Bool)
-> (RangeError t -> RangeError t -> Bool)
-> (RangeError t -> RangeError t -> Bool)
-> (RangeError t -> RangeError t -> RangeError t)
-> (RangeError t -> RangeError t -> RangeError t)
-> Ord (RangeError t)
RangeError t -> RangeError t -> Bool
RangeError t -> RangeError t -> Ordering
RangeError t -> RangeError t -> RangeError t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (RangeError t)
forall t. Ord t => RangeError t -> RangeError t -> Bool
forall t. Ord t => RangeError t -> RangeError t -> Ordering
forall t. Ord t => RangeError t -> RangeError t -> RangeError t
min :: RangeError t -> RangeError t -> RangeError t
$cmin :: forall t. Ord t => RangeError t -> RangeError t -> RangeError t
max :: RangeError t -> RangeError t -> RangeError t
$cmax :: forall t. Ord t => RangeError t -> RangeError t -> RangeError t
>= :: RangeError t -> RangeError t -> Bool
$c>= :: forall t. Ord t => RangeError t -> RangeError t -> Bool
> :: RangeError t -> RangeError t -> Bool
$c> :: forall t. Ord t => RangeError t -> RangeError t -> Bool
<= :: RangeError t -> RangeError t -> Bool
$c<= :: forall t. Ord t => RangeError t -> RangeError t -> Bool
< :: RangeError t -> RangeError t -> Bool
$c< :: forall t. Ord t => RangeError t -> RangeError t -> Bool
compare :: RangeError t -> RangeError t -> Ordering
$ccompare :: forall t. Ord t => RangeError t -> RangeError t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (RangeError t)
Ord, Int -> RangeError t -> ShowS
[RangeError t] -> ShowS
RangeError t -> String
(Int -> RangeError t -> ShowS)
-> (RangeError t -> String)
-> ([RangeError t] -> ShowS)
-> Show (RangeError t)
forall t. Show t => Int -> RangeError t -> ShowS
forall t. Show t => [RangeError t] -> ShowS
forall t. Show t => RangeError t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangeError t] -> ShowS
$cshowList :: forall t. Show t => [RangeError t] -> ShowS
show :: RangeError t -> String
$cshow :: forall t. Show t => RangeError t -> String
showsPrec :: Int -> RangeError t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> RangeError t -> ShowS
Show)

-- | Array dimenstion mismatch error.
data ArrayDimensionMismatch = ArrayDimensionMismatch
  { -- | Dimension expected by the library.
    ArrayDimensionMismatch -> Int
arrDimExpected  :: !Int
    -- | Dimension provided by the database.
  , ArrayDimensionMismatch -> Int
arrDimDelivered :: !Int
  } deriving (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
(ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool)
-> (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool)
-> Eq ArrayDimensionMismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
$c/= :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
== :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
$c== :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
Eq, Eq ArrayDimensionMismatch
Eq ArrayDimensionMismatch
-> (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Ordering)
-> (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool)
-> (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool)
-> (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool)
-> (ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool)
-> (ArrayDimensionMismatch
    -> ArrayDimensionMismatch -> ArrayDimensionMismatch)
-> (ArrayDimensionMismatch
    -> ArrayDimensionMismatch -> ArrayDimensionMismatch)
-> Ord ArrayDimensionMismatch
ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
ArrayDimensionMismatch -> ArrayDimensionMismatch -> Ordering
ArrayDimensionMismatch
-> ArrayDimensionMismatch -> ArrayDimensionMismatch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrayDimensionMismatch
-> ArrayDimensionMismatch -> ArrayDimensionMismatch
$cmin :: ArrayDimensionMismatch
-> ArrayDimensionMismatch -> ArrayDimensionMismatch
max :: ArrayDimensionMismatch
-> ArrayDimensionMismatch -> ArrayDimensionMismatch
$cmax :: ArrayDimensionMismatch
-> ArrayDimensionMismatch -> ArrayDimensionMismatch
>= :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
$c>= :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
> :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
$c> :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
<= :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
$c<= :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
< :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
$c< :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Bool
compare :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Ordering
$ccompare :: ArrayDimensionMismatch -> ArrayDimensionMismatch -> Ordering
$cp1Ord :: Eq ArrayDimensionMismatch
Ord, Int -> ArrayDimensionMismatch -> ShowS
[ArrayDimensionMismatch] -> ShowS
ArrayDimensionMismatch -> String
(Int -> ArrayDimensionMismatch -> ShowS)
-> (ArrayDimensionMismatch -> String)
-> ([ArrayDimensionMismatch] -> ShowS)
-> Show ArrayDimensionMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayDimensionMismatch] -> ShowS
$cshowList :: [ArrayDimensionMismatch] -> ShowS
show :: ArrayDimensionMismatch -> String
$cshow :: ArrayDimensionMismatch -> String
showsPrec :: Int -> ArrayDimensionMismatch -> ShowS
$cshowsPrec :: Int -> ArrayDimensionMismatch -> ShowS
Show)

-- | Row length mismatch error.
data RowLengthMismatch = RowLengthMismatch
  { -- | Length expected by the library.
    RowLengthMismatch -> Int
lengthExpected  :: !Int
    -- | Length delivered by the database.
  , RowLengthMismatch -> Int
lengthDelivered :: !Int
  } deriving (RowLengthMismatch -> RowLengthMismatch -> Bool
(RowLengthMismatch -> RowLengthMismatch -> Bool)
-> (RowLengthMismatch -> RowLengthMismatch -> Bool)
-> Eq RowLengthMismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowLengthMismatch -> RowLengthMismatch -> Bool
$c/= :: RowLengthMismatch -> RowLengthMismatch -> Bool
== :: RowLengthMismatch -> RowLengthMismatch -> Bool
$c== :: RowLengthMismatch -> RowLengthMismatch -> Bool
Eq, Eq RowLengthMismatch
Eq RowLengthMismatch
-> (RowLengthMismatch -> RowLengthMismatch -> Ordering)
-> (RowLengthMismatch -> RowLengthMismatch -> Bool)
-> (RowLengthMismatch -> RowLengthMismatch -> Bool)
-> (RowLengthMismatch -> RowLengthMismatch -> Bool)
-> (RowLengthMismatch -> RowLengthMismatch -> Bool)
-> (RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch)
-> (RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch)
-> Ord RowLengthMismatch
RowLengthMismatch -> RowLengthMismatch -> Bool
RowLengthMismatch -> RowLengthMismatch -> Ordering
RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch
$cmin :: RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch
max :: RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch
$cmax :: RowLengthMismatch -> RowLengthMismatch -> RowLengthMismatch
>= :: RowLengthMismatch -> RowLengthMismatch -> Bool
$c>= :: RowLengthMismatch -> RowLengthMismatch -> Bool
> :: RowLengthMismatch -> RowLengthMismatch -> Bool
$c> :: RowLengthMismatch -> RowLengthMismatch -> Bool
<= :: RowLengthMismatch -> RowLengthMismatch -> Bool
$c<= :: RowLengthMismatch -> RowLengthMismatch -> Bool
< :: RowLengthMismatch -> RowLengthMismatch -> Bool
$c< :: RowLengthMismatch -> RowLengthMismatch -> Bool
compare :: RowLengthMismatch -> RowLengthMismatch -> Ordering
$ccompare :: RowLengthMismatch -> RowLengthMismatch -> Ordering
$cp1Ord :: Eq RowLengthMismatch
Ord, Int -> RowLengthMismatch -> ShowS
[RowLengthMismatch] -> ShowS
RowLengthMismatch -> String
(Int -> RowLengthMismatch -> ShowS)
-> (RowLengthMismatch -> String)
-> ([RowLengthMismatch] -> ShowS)
-> Show RowLengthMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowLengthMismatch] -> ShowS
$cshowList :: [RowLengthMismatch] -> ShowS
show :: RowLengthMismatch -> String
$cshow :: RowLengthMismatch -> String
showsPrec :: Int -> RowLengthMismatch -> ShowS
$cshowsPrec :: Int -> RowLengthMismatch -> ShowS
Show)

-- | Affected/returned rows mismatch error.
data AffectedRowsMismatch = AffectedRowsMismatch
  { -- | Number of rows expected by the library, expressed as sum of acceptable
    -- ranges, eg. [(1,2), (5,10)] means that it would accept 1, 2, 5, 6, 7, 8,
    -- 9 or 10 affected/returned rows.
    AffectedRowsMismatch -> [(Int, Int)]
rowsExpected  :: ![(Int, Int)]
    -- | Number of affected/returned rows by the database.
  , AffectedRowsMismatch -> Int
rowsDelivered :: !Int
  } deriving (AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
(AffectedRowsMismatch -> AffectedRowsMismatch -> Bool)
-> (AffectedRowsMismatch -> AffectedRowsMismatch -> Bool)
-> Eq AffectedRowsMismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
$c/= :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
== :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
$c== :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
Eq, Eq AffectedRowsMismatch
Eq AffectedRowsMismatch
-> (AffectedRowsMismatch -> AffectedRowsMismatch -> Ordering)
-> (AffectedRowsMismatch -> AffectedRowsMismatch -> Bool)
-> (AffectedRowsMismatch -> AffectedRowsMismatch -> Bool)
-> (AffectedRowsMismatch -> AffectedRowsMismatch -> Bool)
-> (AffectedRowsMismatch -> AffectedRowsMismatch -> Bool)
-> (AffectedRowsMismatch
    -> AffectedRowsMismatch -> AffectedRowsMismatch)
-> (AffectedRowsMismatch
    -> AffectedRowsMismatch -> AffectedRowsMismatch)
-> Ord AffectedRowsMismatch
AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
AffectedRowsMismatch -> AffectedRowsMismatch -> Ordering
AffectedRowsMismatch
-> AffectedRowsMismatch -> AffectedRowsMismatch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AffectedRowsMismatch
-> AffectedRowsMismatch -> AffectedRowsMismatch
$cmin :: AffectedRowsMismatch
-> AffectedRowsMismatch -> AffectedRowsMismatch
max :: AffectedRowsMismatch
-> AffectedRowsMismatch -> AffectedRowsMismatch
$cmax :: AffectedRowsMismatch
-> AffectedRowsMismatch -> AffectedRowsMismatch
>= :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
$c>= :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
> :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
$c> :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
<= :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
$c<= :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
< :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
$c< :: AffectedRowsMismatch -> AffectedRowsMismatch -> Bool
compare :: AffectedRowsMismatch -> AffectedRowsMismatch -> Ordering
$ccompare :: AffectedRowsMismatch -> AffectedRowsMismatch -> Ordering
$cp1Ord :: Eq AffectedRowsMismatch
Ord, Int -> AffectedRowsMismatch -> ShowS
[AffectedRowsMismatch] -> ShowS
AffectedRowsMismatch -> String
(Int -> AffectedRowsMismatch -> ShowS)
-> (AffectedRowsMismatch -> String)
-> ([AffectedRowsMismatch] -> ShowS)
-> Show AffectedRowsMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AffectedRowsMismatch] -> ShowS
$cshowList :: [AffectedRowsMismatch] -> ShowS
show :: AffectedRowsMismatch -> String
$cshow :: AffectedRowsMismatch -> String
showsPrec :: Int -> AffectedRowsMismatch -> ShowS
$cshowsPrec :: Int -> AffectedRowsMismatch -> ShowS
Show)

instance E.Exception DetailedQueryError
instance E.Exception QueryError
instance E.Exception HPQTypesError
instance E.Exception LibPQError
instance E.Exception ConversionError
instance E.Exception ArrayItemError
instance (Show t, Typeable t) => E.Exception (InvalidValue t)
instance (Show t, Typeable t) => E.Exception (RangeError t)
instance E.Exception ArrayDimensionMismatch
instance E.Exception RowLengthMismatch
instance E.Exception AffectedRowsMismatch