{-# LANGUAGE OverloadedStrings #-}

module Hasql.Private.Statements where

-- bytestring-tree-builder
import ByteString.TreeBuilder (toByteString)

-- hasql
import Hasql.Statement
import Hasql.Encoders
import Hasql.Decoders

-- hasql-transaction-io
import Hasql.Private.Types

startTransaction :: IsolationLevel -> Mode -> Deferrable -> Bool -> Statement () ()
startTransaction :: IsolationLevel -> Mode -> Deferrable -> Bool -> Statement () ()
startTransaction IsolationLevel
isolation Mode
mode Deferrable
deferrable = 
  forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
stmt Params ()
noParams Result ()
noResult
  where
    stmt :: ByteString
stmt = Builder -> ByteString
toByteString forall a b. (a -> b) -> a -> b
$
      Builder
"START TRANSACTION ISOLATION LEVEL " forall a. Semigroup a => a -> a -> a
<>
      IsolationLevel -> Builder
isolationLevelToSQL IsolationLevel
isolation forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<>
      Mode -> Builder
modeToSQL Mode
mode forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<>
      Deferrable -> Builder
deferrableToSQL Deferrable
deferrable

commitTransaction :: Bool -> Statement () ()
commitTransaction :: Bool -> Statement () ()
commitTransaction = forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
"COMMIT" Params ()
noParams Result ()
noResult

rollbackTransaction :: Bool -> Statement () ()
rollbackTransaction :: Bool -> Statement () ()
rollbackTransaction = forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
"ROLLBACK" Params ()
noParams Result ()
noResult