-- | Description: Send queries, decode results, look up OID for a known type name

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
module Preql.Wire.Query where

import Preql.FromSql
import Preql.Wire.Errors
import Preql.Wire.Internal
import Preql.Wire.ToSql

import Control.Exception (try)
import Control.Monad
import Control.Monad.Except
import Data.IORef
import GHC.TypeNats
import Preql.Imports
import System.IO.Unsafe (unsafePerformIO)

import Debug.Trace

import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Vector.Sized as VS
import qualified Database.PostgreSQL.LibPQ as PQ

-- Cache of OIDs by type name

type TypeCache = IORef (HM.HashMap Text PQ.Oid)

-- | We make the type cache part of the Connection to offer the option of
-- per-Connection (or striped) caches.  It's also reasonable to share a single
-- cache for an entire multi-threaded program; the @IORef@ supports this usage.
data Connection = Connection
  { Connection -> Connection
rawConnection :: !PQ.Connection
  , Connection -> TypeCache
typeCache :: !TypeCache
  }

connectdbSharedCache :: ByteString -> IO Connection
connectdbSharedCache :: ByteString -> IO Connection
connectdbSharedCache ByteString
str = Connection -> TypeCache -> Connection
Connection (Connection -> TypeCache -> Connection)
-> IO Connection -> IO (TypeCache -> Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Connection
PQ.connectdb ByteString
str IO (TypeCache -> Connection) -> IO TypeCache -> IO Connection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeCache -> IO TypeCache
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeCache
globalCache

connectdbNewCache :: ByteString -> IO Connection
connectdbNewCache :: ByteString -> IO Connection
connectdbNewCache ByteString
str = Connection -> TypeCache -> Connection
Connection (Connection -> TypeCache -> Connection)
-> IO Connection -> IO (TypeCache -> Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Connection
PQ.connectdb ByteString
str IO (TypeCache -> Connection) -> IO TypeCache -> IO Connection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Oid -> IO TypeCache
forall a. a -> IO (IORef a)
newIORef HashMap Text Oid
forall a. Monoid a => a
mempty

finish :: Connection -> IO ()
finish :: Connection -> IO ()
finish (Connection Connection
conn TypeCache
_) = Connection -> IO ()
PQ.finish Connection
conn

globalCache :: TypeCache
globalCache :: TypeCache
globalCache = IO TypeCache -> TypeCache
forall a. IO a -> a
unsafePerformIO (HashMap Text Oid -> IO TypeCache
forall a. a -> IO (IORef a)
newIORef HashMap Text Oid
forall a. Monoid a => a
mempty)

-- send queries, receiving results

queryWith :: KnownNat (Width r) =>
  RowEncoder p -> RowDecoder (Width r) r -> Connection ->
  Query (Width r) -> p -> IO (Either QueryError (Vector r))
queryWith :: RowEncoder p
-> RowDecoder (Width r) r
-> Connection
-> Query (Width r)
-> p
-> IO (Either QueryError (Vector r))
queryWith RowEncoder p
enc RowDecoder (Width r) r
dec conn :: Connection
conn@(Connection Connection
pqConn TypeCache
cache) (Query ByteString
q) p
params = do
  Either QueryError Result
e_result <- RowEncoder p
-> Connection -> ByteString -> p -> IO (Either QueryError Result)
forall p.
RowEncoder p
-> Connection -> ByteString -> p -> IO (Either QueryError Result)
execParams RowEncoder p
enc Connection
pqConn ByteString
q p
params
  String -> IO ()
traceEventIO String
"execParams > decodeVector"
  case Either QueryError Result
e_result of
    Left QueryError
err   -> Either QueryError (Vector r) -> IO (Either QueryError (Vector r))
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError (Vector r)
forall a b. a -> Either a b
Left QueryError
err)
    Right Result
rows -> Connection
-> RowDecoder (Width r) r
-> Result
-> IO (Either QueryError (Vector r))
forall (n :: Nat) a.
KnownNat n =>
Connection
-> RowDecoder n a -> Result -> IO (Either QueryError (Vector a))
decodeVector Connection
conn RowDecoder (Width r) r
dec Result
rows

-- If there is no result, we don't need a Decoder
queryWith_ :: RowEncoder p -> Connection -> Query n -> p -> IO (Either QueryError ())
queryWith_ :: RowEncoder p
-> Connection -> Query n -> p -> IO (Either QueryError ())
queryWith_ RowEncoder p
enc (Connection Connection
conn TypeCache
_) (Query ByteString
q) p
params = do
    Either QueryError Result
e_result <- RowEncoder p
-> Connection -> ByteString -> p -> IO (Either QueryError Result)
forall p.
RowEncoder p
-> Connection -> ByteString -> p -> IO (Either QueryError Result)
execParams RowEncoder p
enc Connection
conn ByteString
q p
params
    Either QueryError () -> IO (Either QueryError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either QueryError Result -> Either QueryError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Either QueryError Result
e_result)

query :: (ToSql p, FromSql r, KnownNat (Width r)) =>
    Connection -> Query (Width r) -> p -> IO (Either QueryError (Vector r))
query :: Connection
-> Query (Width r) -> p -> IO (Either QueryError (Vector r))
query = RowEncoder p
-> RowDecoder (Width r) r
-> Connection
-> Query (Width r)
-> p
-> IO (Either QueryError (Vector r))
forall r p.
KnownNat (Width r) =>
RowEncoder p
-> RowDecoder (Width r) r
-> Connection
-> Query (Width r)
-> p
-> IO (Either QueryError (Vector r))
queryWith RowEncoder p
forall a. ToSql a => RowEncoder a
toSql RowDecoder (Width r) r
forall a. FromSql a => RowDecoder (Width a) a
fromSql

query_ :: ToSql p => Connection -> Query n -> p -> IO (Either QueryError ())
query_ :: Connection -> Query n -> p -> IO (Either QueryError ())
query_ = RowEncoder p
-> Connection -> Query n -> p -> IO (Either QueryError ())
forall p (n :: Nat).
RowEncoder p
-> Connection -> Query n -> p -> IO (Either QueryError ())
queryWith_ RowEncoder p
forall a. ToSql a => RowEncoder a
toSql

execParams :: RowEncoder p -> PQ.Connection -> ByteString -> p -> IO (Either QueryError PQ.Result)
execParams :: RowEncoder p
-> Connection -> ByteString -> p -> IO (Either QueryError Result)
execParams RowEncoder p
enc Connection
conn ByteString
q p
params = do
    Either Text Result
e_result <- Connection -> Maybe Result -> IO (Either Text Result)
forall a. Connection -> Maybe a -> IO (Either Text a)
connectionError Connection
conn (Maybe Result -> IO (Either Text Result))
-> IO (Maybe Result) -> IO (Either Text Result)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
PQ.execParams Connection
conn ByteString
q (RowEncoder p -> p -> [Maybe (Oid, ByteString, Format)]
forall p. RowEncoder p -> p -> [Maybe (Oid, ByteString, Format)]
runEncoder RowEncoder p
enc p
params) Format
PQ.Binary
    case Either Text Result
e_result of
        Left Text
err -> Either QueryError Result -> IO (Either QueryError Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError Result
forall a b. a -> Either a b
Left (Text -> QueryError
ConnectionError Text
err))
        Right Result
res -> do
            ExecStatus
status <- Result -> IO ExecStatus
PQ.resultStatus Result
res
            if ExecStatus
status ExecStatus -> ExecStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExecStatus
PQ.CommandOk Bool -> Bool -> Bool
|| ExecStatus
status ExecStatus -> ExecStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExecStatus
PQ.TuplesOk
                then Either QueryError Result -> IO (Either QueryError Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> Either QueryError Result
forall a b. b -> Either a b
Right Result
res)
                else do
                    Text
msg <- Result -> IO (Maybe ByteString)
PQ.resultErrorMessage Result
res
                        IO (Maybe ByteString) -> (Maybe ByteString -> Text) -> IO Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Text
T.pack (ExecStatus -> String
forall a. Show a => a -> String
show ExecStatus
status)) (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode)
                    Either QueryError Result -> IO (Either QueryError Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError Result
forall a b. a -> Either a b
Left (Text -> QueryError
ConnectionError Text
msg))

connectionError :: PQ.Connection -> Maybe a -> IO (Either Text a)
connectionError :: Connection -> Maybe a -> IO (Either Text a)
connectionError Connection
_conn (Just a
a) = Either Text a -> IO (Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either Text a
forall a b. b -> Either a b
Right a
a)
connectionError Connection
conn Maybe a
Nothing = do
    Maybe ByteString
m_msg <- IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
conn
    case Maybe ByteString
m_msg of
        Just ByteString
msg -> Either Text a -> IO (Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text a
forall a b. a -> Either a b
Left (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
msg))
        Maybe ByteString
Nothing  -> Either Text a -> IO (Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text a
forall a b. a -> Either a b
Left Text
"No error message available")

-- decoding

decodeVector :: KnownNat n =>
  Connection -> RowDecoder n a -> PQ.Result -> IO (Either QueryError (Vector a))
decodeVector :: Connection
-> RowDecoder n a -> Result -> IO (Either QueryError (Vector a))
decodeVector Connection
conn rd :: RowDecoder n a
rd@(RowDecoder Vector n PgType
pgtypes InternalDecoder a
_parsers) Result
result = do
    [TypeMismatch]
mismatches <- (Vector n (Maybe TypeMismatch) -> [TypeMismatch])
-> IO (Vector n (Maybe TypeMismatch)) -> IO [TypeMismatch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe TypeMismatch] -> [TypeMismatch]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TypeMismatch] -> [TypeMismatch])
-> (Vector n (Maybe TypeMismatch) -> [Maybe TypeMismatch])
-> Vector n (Maybe TypeMismatch)
-> [TypeMismatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector n (Maybe TypeMismatch) -> [Maybe TypeMismatch]
forall (n :: Nat) a. Vector n a -> [a]
VS.toList) (IO (Vector n (Maybe TypeMismatch)) -> IO [TypeMismatch])
-> IO (Vector n (Maybe TypeMismatch)) -> IO [TypeMismatch]
forall a b. (a -> b) -> a -> b
$ Vector Vector n (Column, PgType)
-> ((Column, PgType) -> IO (Maybe TypeMismatch))
-> IO (Vector n (Maybe TypeMismatch))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Vector n Column
-> Vector n PgType -> Vector Vector n (Column, PgType)
forall (n :: Nat) a b. Vector n a -> Vector n b -> Vector n (a, b)
VS.zip (Column -> Vector n Column
forall (n :: Nat) a. (KnownNat n, Num a) => a -> Vector n a
VS.enumFromN Column
0) Vector n PgType
pgtypes) (((Column, PgType) -> IO (Maybe TypeMismatch))
 -> IO (Vector n (Maybe TypeMismatch)))
-> ((Column, PgType) -> IO (Maybe TypeMismatch))
-> IO (Vector n (Maybe TypeMismatch))
forall a b. (a -> b) -> a -> b
$ \(column :: Column
column@(PQ.Col CInt
cint), PgType
expected) -> do
        Oid
actual <- Result -> Column -> IO Oid
PQ.ftype Result
result Column
column
        LookupResult
lookupResult <- Connection -> PgType -> IO LookupResult
lookupType Connection
conn PgType
expected
        let mismatch :: IO (Maybe TypeMismatch)
mismatch = do
              Maybe ByteString
m_name <- IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Result -> Column -> IO (Maybe ByteString)
PQ.fname Result
result Column
column
              let columnName :: Maybe Text
columnName = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
m_name
              Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TypeMismatch -> IO (Maybe TypeMismatch))
-> Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall a b. (a -> b) -> a -> b
$ TypeMismatch -> Maybe TypeMismatch
forall a. a -> Maybe a
Just (TypeMismatch :: PgType -> Oid -> Int -> Maybe Text -> TypeMismatch
TypeMismatch{column :: Int
column = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint, Maybe Text
Oid
PgType
columnName :: Maybe Text
actual :: Oid
expected :: PgType
columnName :: Maybe Text
actual :: Oid
expected :: PgType
..})
        case LookupResult
lookupResult of
          Cached Oid
oid | Oid
actual Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeMismatch
forall a. Maybe a
Nothing
          FromDb Oid
oid | Oid
actual Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeMismatch
forall a. Maybe a
Nothing
          Cached Oid
_ -> do -- recheck DB, in case type changed under us
            Either QueryError Oid
e_oid  <- Connection -> PgType -> IO (Either QueryError Oid)
lookupTypeIgnoreCache Connection
conn PgType
expected
            case Either QueryError Oid
e_oid of
              Right Oid
oid | Oid
actual Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeMismatch
forall a. Maybe a
Nothing
              Either QueryError Oid
_ -> IO (Maybe TypeMismatch)
mismatch
          LookupResult
_ -> IO (Maybe TypeMismatch)
mismatch
    if Bool -> Bool
not ([TypeMismatch] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeMismatch]
mismatches)
        then Either QueryError (Vector a) -> IO (Either QueryError (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError (Vector a)
forall a b. a -> Either a b
Left ([TypeMismatch] -> QueryError
PgTypeMismatch [TypeMismatch]
mismatches))
        else do
            (PQ.Row CInt
ntuples) <- IO Row -> IO Row
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Row -> IO Row) -> IO Row -> IO Row
forall a b. (a -> b) -> a -> b
$ Result -> IO Row
PQ.ntuples Result
result
            IORef DecoderState
ref <- DecoderState -> IO (IORef DecoderState)
forall a. a -> IO (IORef a)
newIORef (Result -> Row -> Column -> DecoderState
DecoderState Result
result Row
0 Column
0)
            (Either FieldError (Vector a) -> Either QueryError (Vector a))
-> IO (Either FieldError (Vector a))
-> IO (Either QueryError (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldError -> QueryError)
-> Either FieldError (Vector a) -> Either QueryError (Vector a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FieldError -> QueryError
DecoderError) (IO (Either FieldError (Vector a))
 -> IO (Either QueryError (Vector a)))
-> (IO (Vector a) -> IO (Either FieldError (Vector a)))
-> IO (Vector a)
-> IO (Either QueryError (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Vector a) -> IO (Either FieldError (Vector a))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Vector a) -> IO (Either QueryError (Vector a)))
-> IO (Vector a) -> IO (Either QueryError (Vector a))
forall a b. (a -> b) -> a -> b
$
                Int -> IO a -> IO (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ntuples) (IORef DecoderState -> RowDecoder n a -> Result -> IO a
forall (n :: Nat) a.
IORef DecoderState -> RowDecoder n a -> Result -> IO a
decodeRow IORef DecoderState
ref RowDecoder n a
rd Result
result)
  where

lookupType :: Connection -> PgType -> IO LookupResult
lookupType :: Connection -> PgType -> IO LookupResult
lookupType Connection
_ (Oid Oid
oid Oid
_) = LookupResult -> IO LookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid -> LookupResult
FromDb Oid
oid)
lookupType conn :: Connection
conn@(Connection Connection
_ TypeCache
cacheRef) expected :: PgType
expected@(TypeName Text
name) = do
  HashMap Text Oid
cache <- TypeCache -> IO (HashMap Text Oid)
forall a. IORef a -> IO a
readIORef TypeCache
cacheRef
  case Text -> HashMap Text Oid -> Maybe Oid
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
name HashMap Text Oid
cache of
    Just Oid
oid -> LookupResult -> IO LookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid -> LookupResult
Cached Oid
oid)
    Maybe Oid
Nothing -> Connection -> PgType -> IO (Either QueryError Oid)
lookupTypeIgnoreCache Connection
conn PgType
expected
      IO (Either QueryError Oid)
-> (Either QueryError Oid -> LookupResult) -> IO LookupResult
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (QueryError -> LookupResult)
-> (Oid -> LookupResult) -> Either QueryError Oid -> LookupResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either QueryError -> LookupResult
LookupError Oid -> LookupResult
FromDb

data LookupResult
  = Cached PQ.Oid
  | FromDb PQ.Oid
  | LookupError QueryError

lookupTypeIgnoreCache :: Connection -> PgType -> IO (Either QueryError PQ.Oid)
lookupTypeIgnoreCache :: Connection -> PgType -> IO (Either QueryError Oid)
lookupTypeIgnoreCache Connection
_ (Oid Oid
oid Oid
_) = Either QueryError Oid -> IO (Either QueryError Oid)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid -> Either QueryError Oid
forall a b. b -> Either a b
Right Oid
oid)
lookupTypeIgnoreCache conn :: Connection
conn@(Connection Connection
_ TypeCache
cacheRef) (TypeName Text
name) = do
  Either QueryError (Vector Oid)
e_rows <- Connection
-> Query (Width Oid) -> Text -> IO (Either QueryError (Vector Oid))
forall p r.
(ToSql p, FromSql r, KnownNat (Width r)) =>
Connection
-> Query (Width r) -> p -> IO (Either QueryError (Vector r))
query Connection
conn Query (Width Oid)
"SELECT oid FROM pg_type WHERE typname = $1" Text
name
  case (Vector Oid -> Maybe Oid)
-> Either QueryError (Vector Oid) -> Either QueryError (Maybe Oid)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Oid -> Int -> Maybe Oid
forall a. Vector a -> Int -> Maybe a
V.!? Int
0) Either QueryError (Vector Oid)
e_rows of
    Left QueryError
e -> Either QueryError Oid -> IO (Either QueryError Oid)
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError Oid
forall a b. a -> Either a b
Left QueryError
e)
    Right (Just Oid
oid) -> do
      TypeCache -> (HashMap Text Oid -> (HashMap Text Oid, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef TypeCache
cacheRef (\HashMap Text Oid
cache -> (Text -> Oid -> HashMap Text Oid -> HashMap Text Oid
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
name Oid
oid HashMap Text Oid
cache, ()))
      Either QueryError Oid -> IO (Either QueryError Oid)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid -> Either QueryError Oid
forall a b. b -> Either a b
Right Oid
oid)
    Right Maybe Oid
Nothing -> Either QueryError Oid -> IO (Either QueryError Oid)
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError Oid
forall a b. a -> Either a b
Left (Text -> QueryError
ConnectionError (Text
"No oid for: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)))

-- transactions

data IsolationLevel = ReadCommitted
    | RepeatableRead
    | Serializable
    deriving (Int -> IsolationLevel -> ShowS
[IsolationLevel] -> ShowS
IsolationLevel -> String
(Int -> IsolationLevel -> ShowS)
-> (IsolationLevel -> String)
-> ([IsolationLevel] -> ShowS)
-> Show IsolationLevel
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, ReadPrec [IsolationLevel]
ReadPrec IsolationLevel
Int -> ReadS IsolationLevel
ReadS [IsolationLevel]
(Int -> ReadS IsolationLevel)
-> ReadS [IsolationLevel]
-> ReadPrec IsolationLevel
-> ReadPrec [IsolationLevel]
-> Read IsolationLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IsolationLevel]
$creadListPrec :: ReadPrec [IsolationLevel]
readPrec :: ReadPrec IsolationLevel
$creadPrec :: ReadPrec IsolationLevel
readList :: ReadS [IsolationLevel]
$creadList :: ReadS [IsolationLevel]
readsPrec :: Int -> ReadS IsolationLevel
$creadsPrec :: Int -> ReadS IsolationLevel
Read, IsolationLevel -> IsolationLevel -> Bool
(IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool) -> Eq IsolationLevel
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
Eq IsolationLevel
-> (IsolationLevel -> IsolationLevel -> Ordering)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> IsolationLevel)
-> (IsolationLevel -> IsolationLevel -> IsolationLevel)
-> Ord 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
$cp1Ord :: Eq IsolationLevel
Ord, Int -> IsolationLevel
IsolationLevel -> Int
IsolationLevel -> [IsolationLevel]
IsolationLevel -> IsolationLevel
IsolationLevel -> IsolationLevel -> [IsolationLevel]
IsolationLevel
-> IsolationLevel -> IsolationLevel -> [IsolationLevel]
(IsolationLevel -> IsolationLevel)
-> (IsolationLevel -> IsolationLevel)
-> (Int -> IsolationLevel)
-> (IsolationLevel -> Int)
-> (IsolationLevel -> [IsolationLevel])
-> (IsolationLevel -> IsolationLevel -> [IsolationLevel])
-> (IsolationLevel -> IsolationLevel -> [IsolationLevel])
-> (IsolationLevel
    -> IsolationLevel -> IsolationLevel -> [IsolationLevel])
-> Enum IsolationLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IsolationLevel
-> IsolationLevel -> IsolationLevel -> [IsolationLevel]
$cenumFromThenTo :: IsolationLevel
-> IsolationLevel -> IsolationLevel -> [IsolationLevel]
enumFromTo :: IsolationLevel -> IsolationLevel -> [IsolationLevel]
$cenumFromTo :: IsolationLevel -> IsolationLevel -> [IsolationLevel]
enumFromThen :: IsolationLevel -> IsolationLevel -> [IsolationLevel]
$cenumFromThen :: IsolationLevel -> IsolationLevel -> [IsolationLevel]
enumFrom :: IsolationLevel -> [IsolationLevel]
$cenumFrom :: IsolationLevel -> [IsolationLevel]
fromEnum :: IsolationLevel -> Int
$cfromEnum :: IsolationLevel -> Int
toEnum :: Int -> IsolationLevel
$ctoEnum :: Int -> IsolationLevel
pred :: IsolationLevel -> IsolationLevel
$cpred :: IsolationLevel -> IsolationLevel
succ :: IsolationLevel -> IsolationLevel
$csucc :: IsolationLevel -> IsolationLevel
Enum, IsolationLevel
IsolationLevel -> IsolationLevel -> Bounded IsolationLevel
forall a. a -> a -> Bounded a
maxBound :: IsolationLevel
$cmaxBound :: IsolationLevel
minBound :: IsolationLevel
$cminBound :: IsolationLevel
Bounded)

begin :: Connection -> IsolationLevel -> IO (Either QueryError ())
begin :: Connection -> IsolationLevel -> IO (Either QueryError ())
begin Connection
conn IsolationLevel
level = Connection -> Query Any -> () -> IO (Either QueryError ())
forall p (n :: Nat).
ToSql p =>
Connection -> Query n -> p -> IO (Either QueryError ())
query_ Connection
conn Query Any
q () where
  q :: Query Any
q = case IsolationLevel
level of
    IsolationLevel
ReadCommitted  -> Query Any
"BEGIN ISOLATION LEVEL READ COMMITTED"
    IsolationLevel
RepeatableRead -> Query Any
"BEGIN ISOLATION LEVEL REPEATABLE READ"
    IsolationLevel
Serializable   -> Query Any
"BEGIN ISOLATION LEVEL SERIALIZABLE"

commit :: Connection -> IO (Either QueryError ())
commit :: Connection -> IO (Either QueryError ())
commit Connection
conn = Connection -> Query Any -> () -> IO (Either QueryError ())
forall p (n :: Nat).
ToSql p =>
Connection -> Query n -> p -> IO (Either QueryError ())
query_ Connection
conn Query Any
"COMMIT" ()

rollback :: Connection -> IO (Either QueryError ())
rollback :: Connection -> IO (Either QueryError ())
rollback Connection
conn = Connection -> Query Any -> () -> IO (Either QueryError ())
forall p (n :: Nat).
ToSql p =>
Connection -> Query n -> p -> IO (Either QueryError ())
query_ Connection
conn Query Any
"ROLLBACK" ()