-- | Definition of main exception type.
module Database.PostgreSQL.PQTypes.Internal.Exception
  ( DBException (..)
  , rethrowWithContext
  ) where

import Control.Exception qualified as E
import GHC.Stack

import Database.PostgreSQL.PQTypes.Internal.BackendPid
import Database.PostgreSQL.PQTypes.SQL.Class

-- | Main exception type. All exceptions thrown by
-- the library are additionally wrapped in this type.
data DBException = forall e sql. (E.Exception e, Show sql) => DBException
  { ()
dbeQueryContext :: !sql
  -- ^ Last SQL query that was executed.
  , DBException -> BackendPid
dbeBackendPid :: !BackendPid
  -- ^ Process ID of the server process attached to the current session.
  , ()
dbeError :: !e
  -- ^ Specific error.
  , DBException -> CallStack
dbeCallStack :: CallStack
  }

deriving instance Show DBException

instance E.Exception DBException

-- | Rethrow supplied exception enriched with given SQL.
rethrowWithContext
  :: (HasCallStack, IsSQL sql)
  => sql
  -> BackendPid
  -> E.SomeException
  -> IO a
rethrowWithContext :: forall sql a.
(HasCallStack, IsSQL sql) =>
sql -> BackendPid -> SomeException -> IO a
rethrowWithContext sql
sql BackendPid
pid (E.SomeException e
e) =
  DBException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
    DBException
      { dbeQueryContext :: sql
dbeQueryContext = sql
sql
      , dbeBackendPid :: BackendPid
dbeBackendPid = BackendPid
pid
      , dbeError :: e
dbeError = e
e
      , dbeCallStack :: CallStack
dbeCallStack = CallStack
HasCallStack => CallStack
callStack
      }