{-|
Module: Squeal.PostgreSQL.Session.Exception
Description: exceptions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

exceptions
-}

{-# LANGUAGE
    OverloadedStrings
  , PatternSynonyms
#-}

module Squeal.PostgreSQL.Session.Exception
  ( SquealException (..)
  , pattern UniqueViolation
  , pattern CheckViolation
  , pattern SerializationFailure
  , pattern DeadlockDetected
  , SQLState (..)
  , LibPQ.ExecStatus (..)
  , catchSqueal
  , handleSqueal
  , trySqueal
  , throwSqueal
  ) where

import Control.Monad.Catch
import Data.ByteString (ByteString)
import Data.Text (Text)

import qualified Database.PostgreSQL.LibPQ as LibPQ

-- $setup
-- >>> import Squeal.PostgreSQL

-- | the state of LibPQ
data SQLState = SQLState
  { SQLState -> ExecStatus
sqlExecStatus :: LibPQ.ExecStatus
  , SQLState -> ByteString
sqlStateCode :: ByteString
    -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html
  , SQLState -> ByteString
sqlErrorMessage :: ByteString
  } deriving (SQLState -> SQLState -> Bool
(SQLState -> SQLState -> Bool)
-> (SQLState -> SQLState -> Bool) -> Eq SQLState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SQLState -> SQLState -> Bool
$c/= :: SQLState -> SQLState -> Bool
== :: SQLState -> SQLState -> Bool
$c== :: SQLState -> SQLState -> Bool
Eq, Int -> SQLState -> ShowS
[SQLState] -> ShowS
SQLState -> String
(Int -> SQLState -> ShowS)
-> (SQLState -> String) -> ([SQLState] -> ShowS) -> Show SQLState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SQLState] -> ShowS
$cshowList :: [SQLState] -> ShowS
show :: SQLState -> String
$cshow :: SQLState -> String
showsPrec :: Int -> SQLState -> ShowS
$cshowsPrec :: Int -> SQLState -> ShowS
Show)

-- | `Exception`s that can be thrown by Squeal.
data SquealException
  = SQLException SQLState
  -- ^ SQL exception state
  | ConnectionException Text
  -- ^ `Database.PostgreSQL.LibPQ` function connection exception
  | DecodingException Text Text
  -- ^ decoding exception function and error message
  | ColumnsException Text LibPQ.Column
  -- ^ unexpected number of columns
  | RowsException Text LibPQ.Row LibPQ.Row
  -- ^ too few rows, expected at least and actual number of rows
  deriving (SquealException -> SquealException -> Bool
(SquealException -> SquealException -> Bool)
-> (SquealException -> SquealException -> Bool)
-> Eq SquealException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SquealException -> SquealException -> Bool
$c/= :: SquealException -> SquealException -> Bool
== :: SquealException -> SquealException -> Bool
$c== :: SquealException -> SquealException -> Bool
Eq, Int -> SquealException -> ShowS
[SquealException] -> ShowS
SquealException -> String
(Int -> SquealException -> ShowS)
-> (SquealException -> String)
-> ([SquealException] -> ShowS)
-> Show SquealException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SquealException] -> ShowS
$cshowList :: [SquealException] -> ShowS
show :: SquealException -> String
$cshow :: SquealException -> String
showsPrec :: Int -> SquealException -> ShowS
$cshowsPrec :: Int -> SquealException -> ShowS
Show)
instance Exception SquealException

-- | A pattern for unique violation exceptions.
pattern UniqueViolation :: ByteString -> SquealException
pattern $bUniqueViolation :: ByteString -> SquealException
$mUniqueViolation :: forall r. SquealException -> (ByteString -> r) -> (Void# -> r) -> r
UniqueViolation msg =
  SQLException (SQLState LibPQ.FatalError "23505" msg)
-- | A pattern for check constraint violation exceptions.
pattern CheckViolation :: ByteString -> SquealException
pattern $bCheckViolation :: ByteString -> SquealException
$mCheckViolation :: forall r. SquealException -> (ByteString -> r) -> (Void# -> r) -> r
CheckViolation msg =
  SQLException (SQLState LibPQ.FatalError "23514" msg)
-- | A pattern for serialization failure exceptions.
pattern SerializationFailure :: ByteString -> SquealException
pattern $bSerializationFailure :: ByteString -> SquealException
$mSerializationFailure :: forall r. SquealException -> (ByteString -> r) -> (Void# -> r) -> r
SerializationFailure msg =
  SQLException (SQLState LibPQ.FatalError "40001" msg)
-- | A pattern for deadlock detection exceptions.
pattern DeadlockDetected :: ByteString -> SquealException
pattern $bDeadlockDetected :: ByteString -> SquealException
$mDeadlockDetected :: forall r. SquealException -> (ByteString -> r) -> (Void# -> r) -> r
DeadlockDetected msg =
  SQLException (SQLState LibPQ.FatalError "40P01" msg)

-- | Catch `SquealException`s.
catchSqueal
  :: MonadCatch m
  => m a
  -> (SquealException -> m a) -- ^ handler
  -> m a
catchSqueal :: m a -> (SquealException -> m a) -> m a
catchSqueal = m a -> (SquealException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | Handle `SquealException`s.
handleSqueal
  :: MonadCatch m
  => (SquealException -> m a) -- ^ handler
  -> m a -> m a
handleSqueal :: (SquealException -> m a) -> m a -> m a
handleSqueal = (SquealException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle

-- | `Either` return a `SquealException` or a result.
trySqueal :: MonadCatch m => m a -> m (Either SquealException a)
trySqueal :: m a -> m (Either SquealException a)
trySqueal = m a -> m (Either SquealException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try

-- | Throw `SquealException`s.
throwSqueal :: MonadThrow m => SquealException -> m a
throwSqueal :: SquealException -> m a
throwSqueal = SquealException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM