module Database.PostgreSQL.PQTypes.Transaction.Settings (
    RestartPredicate(..)
  , TransactionSettings(..)
  , IsolationLevel(..)
  , Permissions(..)
  , defaultTransactionSettings
  ) where

import qualified Control.Exception as E

-- | Predicate that determines whether the transaction has to be restarted.
data RestartPredicate = forall e. E.Exception e
                     => RestartPredicate (e -> Integer -> Bool)

instance Show RestartPredicate where
  showsPrec :: Int -> RestartPredicate -> ShowS
showsPrec Int
_ RestartPredicate{} = forall a. [a] -> [a] -> [a]
(++) String
"RestartPredicate"

data TransactionSettings = TransactionSettings
  { -- | If set to True, transaction will be automatically started at the
    -- beginning of database action and after each 'commit' / 'rollback'.  If
    -- set to False, no transaction will automatically start in either of above
    -- cases.
    TransactionSettings -> Bool
tsAutoTransaction  :: !Bool
    -- | Isolation level of all transactions.
  , TransactionSettings -> IsolationLevel
tsIsolationLevel   :: !IsolationLevel
    -- | Defines behavior of 'withTransaction' in case exceptions thrown within
    -- supplied monadic action are not caught and reach its body.  If set to
    -- 'Nothing', exceptions will be propagated as usual. If set to 'Just' f,
    -- exceptions will be intercepted and passed to f along with a number that
    -- indicates how many times the transaction block already failed. If f
    -- returns 'True', the transaction is restarted. Otherwise the exception is
    -- further propagated. This allows for restarting transactions e.g. in case
    -- of serialization failure. It is up to the caller to ensure that is it
    -- safe to execute supplied monadic action multiple times.
  , TransactionSettings -> Maybe RestartPredicate
tsRestartPredicate :: !(Maybe RestartPredicate)
    -- | Permissions of all transactions.
  , TransactionSettings -> Permissions
tsPermissions      :: !Permissions
  } deriving Int -> TransactionSettings -> ShowS
[TransactionSettings] -> ShowS
TransactionSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionSettings] -> ShowS
$cshowList :: [TransactionSettings] -> ShowS
show :: TransactionSettings -> String
$cshow :: TransactionSettings -> String
showsPrec :: Int -> TransactionSettings -> ShowS
$cshowsPrec :: Int -> TransactionSettings -> ShowS
Show

data IsolationLevel = DefaultLevel | ReadCommitted | RepeatableRead | Serializable
  deriving (IsolationLevel -> IsolationLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsolationLevel -> IsolationLevel -> Bool
$c/= :: IsolationLevel -> IsolationLevel -> Bool
== :: IsolationLevel -> IsolationLevel -> Bool
$c== :: IsolationLevel -> IsolationLevel -> Bool
Eq, Eq IsolationLevel
IsolationLevel -> IsolationLevel -> Bool
IsolationLevel -> IsolationLevel -> Ordering
IsolationLevel -> IsolationLevel -> IsolationLevel
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 :: IsolationLevel -> IsolationLevel -> IsolationLevel
$cmin :: IsolationLevel -> IsolationLevel -> IsolationLevel
max :: IsolationLevel -> IsolationLevel -> IsolationLevel
$cmax :: IsolationLevel -> IsolationLevel -> IsolationLevel
>= :: IsolationLevel -> IsolationLevel -> Bool
$c>= :: IsolationLevel -> IsolationLevel -> Bool
> :: IsolationLevel -> IsolationLevel -> Bool
$c> :: IsolationLevel -> IsolationLevel -> Bool
<= :: IsolationLevel -> IsolationLevel -> Bool
$c<= :: IsolationLevel -> IsolationLevel -> Bool
< :: IsolationLevel -> IsolationLevel -> Bool
$c< :: IsolationLevel -> IsolationLevel -> Bool
compare :: IsolationLevel -> IsolationLevel -> Ordering
$ccompare :: IsolationLevel -> IsolationLevel -> Ordering
Ord, Int -> IsolationLevel -> ShowS
[IsolationLevel] -> ShowS
IsolationLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsolationLevel] -> ShowS
$cshowList :: [IsolationLevel] -> ShowS
show :: IsolationLevel -> String
$cshow :: IsolationLevel -> String
showsPrec :: Int -> IsolationLevel -> ShowS
$cshowsPrec :: Int -> IsolationLevel -> ShowS
Show)

data Permissions = DefaultPermissions | ReadOnly | ReadWrite
  deriving (Permissions -> Permissions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c== :: Permissions -> Permissions -> Bool
Eq, Eq Permissions
Permissions -> Permissions -> Bool
Permissions -> Permissions -> Ordering
Permissions -> Permissions -> Permissions
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 :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmax :: Permissions -> Permissions -> Permissions
>= :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c< :: Permissions -> Permissions -> Bool
compare :: Permissions -> Permissions -> Ordering
$ccompare :: Permissions -> Permissions -> Ordering
Ord, Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Permissions] -> ShowS
$cshowList :: [Permissions] -> ShowS
show :: Permissions -> String
$cshow :: Permissions -> String
showsPrec :: Int -> Permissions -> ShowS
$cshowsPrec :: Int -> Permissions -> ShowS
Show)

-- | Default transaction settings.
defaultTransactionSettings :: TransactionSettings
defaultTransactionSettings :: TransactionSettings
defaultTransactionSettings =
  TransactionSettings
  { tsAutoTransaction :: Bool
tsAutoTransaction  = Bool
True
  , tsIsolationLevel :: IsolationLevel
tsIsolationLevel   = IsolationLevel
DefaultLevel
  , tsRestartPredicate :: Maybe RestartPredicate
tsRestartPredicate = forall a. Maybe a
Nothing
  , tsPermissions :: Permissions
tsPermissions      = Permissions
DefaultPermissions
  }