{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.Tx.Simple.Internal
(
module Database.PostgreSQL.Tx.Simple.Internal
) where
import Data.Kind (Constraint)
import Database.PostgreSQL.Tx (TxEnv, TxException, TxM, askTxEnv, mapExceptionTx)
import Database.PostgreSQL.Tx.Unsafe (unsafeMkTxException, unsafeMksTxM, unsafeRunIOInTxM, unsafeRunTxM)
import qualified Data.ByteString.Char8 as Char8
import qualified Database.PostgreSQL.Simple as Simple
type PgSimpleEnv r = (TxEnv Simple.Connection r) :: Constraint
type PgSimpleM a = forall r. (PgSimpleEnv r) => TxM r a
unsafeRunTransaction
:: (PgSimpleEnv r)
=> (Simple.Connection -> IO a -> IO a)
-> r -> TxM r a -> IO a
unsafeRunTransaction :: (Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
unsafeRunTransaction Connection -> IO a -> IO a
f r
r TxM r a
x = do
r -> TxM r a -> IO a
forall r a. r -> TxM r a -> IO a
unsafeRunTxM r
r do
Connection
conn <- TxM r Connection
forall a r. TxEnv a r => TxM r a
askTxEnv
IO a -> TxM r a
forall a r. IO a -> TxM r a
unsafeRunIOInTxM (IO a -> TxM r a) -> IO a -> TxM r a
forall a b. (a -> b) -> a -> b
$ Connection -> IO a -> IO a
f Connection
conn (r -> TxM r a -> IO a
forall r a. r -> TxM r a -> IO a
unsafeRunTxM r
r TxM r a
x)
fromSqlError :: Simple.SqlError -> TxException
fromSqlError :: SqlError -> TxException
fromSqlError = (SqlError -> Maybe String) -> SqlError -> TxException
forall e. Exception e => (e -> Maybe String) -> e -> TxException
unsafeMkTxException (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (SqlError -> String) -> SqlError -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Char8.unpack (ByteString -> String)
-> (SqlError -> ByteString) -> SqlError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlError -> ByteString
Simple.sqlState)
unsafeFromPgSimple
:: (Simple.Connection -> IO x)
-> PgSimpleM x
unsafeFromPgSimple :: (Connection -> IO x) -> PgSimpleM x
unsafeFromPgSimple Connection -> IO x
f =
(SqlError -> Maybe TxException) -> TxM r x -> TxM r x
forall e e' r a.
(Exception e, Exception e') =>
(e -> Maybe e') -> TxM r a -> TxM r a
mapExceptionTx (TxException -> Maybe TxException
forall a. a -> Maybe a
Just (TxException -> Maybe TxException)
-> (SqlError -> TxException) -> SqlError -> Maybe TxException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlError -> TxException
fromSqlError) do
(Connection -> IO x) -> TxM r x
forall a r b. TxEnv a r => (a -> IO b) -> TxM r b
unsafeMksTxM Connection -> IO x
f
unsafeFromPgSimple1
:: (Simple.Connection -> a1 -> IO x)
-> a1 -> PgSimpleM x
unsafeFromPgSimple1 :: (Connection -> a1 -> IO x) -> a1 -> PgSimpleM x
unsafeFromPgSimple1 Connection -> a1 -> IO x
f a1
a1 = (Connection -> IO x) -> PgSimpleM x
forall x. (Connection -> IO x) -> PgSimpleM x
unsafeFromPgSimple \Connection
c -> Connection -> a1 -> IO x
f Connection
c a1
a1
unsafeFromPgSimple2
:: (Simple.Connection -> a1 -> a2 -> IO x)
-> a1 -> a2 -> PgSimpleM x
unsafeFromPgSimple2 :: (Connection -> a1 -> a2 -> IO x) -> a1 -> a2 -> PgSimpleM x
unsafeFromPgSimple2 Connection -> a1 -> a2 -> IO x
f a1
a1 a2
a2 = (Connection -> IO x) -> PgSimpleM x
forall x. (Connection -> IO x) -> PgSimpleM x
unsafeFromPgSimple \Connection
c -> Connection -> a1 -> a2 -> IO x
f Connection
c a1
a1 a2
a2