module Polysemy.Hasql.Statement.Transaction where

import Exon (exon)
import Hasql.Decoders (noResult)
import Hasql.Encoders (noParams)
import Hasql.Statement (Statement (Statement))

data AccessMode =
  Read
  |
  Write
  deriving stock (Int -> AccessMode -> ShowS
[AccessMode] -> ShowS
AccessMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessMode] -> ShowS
$cshowList :: [AccessMode] -> ShowS
show :: AccessMode -> String
$cshow :: AccessMode -> String
showsPrec :: Int -> AccessMode -> ShowS
$cshowsPrec :: Int -> AccessMode -> ShowS
Show, AccessMode -> AccessMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessMode -> AccessMode -> Bool
$c/= :: AccessMode -> AccessMode -> Bool
== :: AccessMode -> AccessMode -> Bool
$c== :: AccessMode -> AccessMode -> Bool
Eq, Eq AccessMode
AccessMode -> AccessMode -> Bool
AccessMode -> AccessMode -> Ordering
AccessMode -> AccessMode -> AccessMode
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 :: AccessMode -> AccessMode -> AccessMode
$cmin :: AccessMode -> AccessMode -> AccessMode
max :: AccessMode -> AccessMode -> AccessMode
$cmax :: AccessMode -> AccessMode -> AccessMode
>= :: AccessMode -> AccessMode -> Bool
$c>= :: AccessMode -> AccessMode -> Bool
> :: AccessMode -> AccessMode -> Bool
$c> :: AccessMode -> AccessMode -> Bool
<= :: AccessMode -> AccessMode -> Bool
$c<= :: AccessMode -> AccessMode -> Bool
< :: AccessMode -> AccessMode -> Bool
$c< :: AccessMode -> AccessMode -> Bool
compare :: AccessMode -> AccessMode -> Ordering
$ccompare :: AccessMode -> AccessMode -> Ordering
Ord, Int -> AccessMode
AccessMode -> Int
AccessMode -> [AccessMode]
AccessMode -> AccessMode
AccessMode -> AccessMode -> [AccessMode]
AccessMode -> AccessMode -> AccessMode -> [AccessMode]
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 :: AccessMode -> AccessMode -> AccessMode -> [AccessMode]
$cenumFromThenTo :: AccessMode -> AccessMode -> AccessMode -> [AccessMode]
enumFromTo :: AccessMode -> AccessMode -> [AccessMode]
$cenumFromTo :: AccessMode -> AccessMode -> [AccessMode]
enumFromThen :: AccessMode -> AccessMode -> [AccessMode]
$cenumFromThen :: AccessMode -> AccessMode -> [AccessMode]
enumFrom :: AccessMode -> [AccessMode]
$cenumFrom :: AccessMode -> [AccessMode]
fromEnum :: AccessMode -> Int
$cfromEnum :: AccessMode -> Int
toEnum :: Int -> AccessMode
$ctoEnum :: Int -> AccessMode
pred :: AccessMode -> AccessMode
$cpred :: AccessMode -> AccessMode
succ :: AccessMode -> AccessMode
$csucc :: AccessMode -> AccessMode
Enum, AccessMode
forall a. a -> a -> Bounded a
maxBound :: AccessMode
$cmaxBound :: AccessMode
minBound :: AccessMode
$cminBound :: AccessMode
Bounded)

data IsolationLevel =
  ReadCommitted
  |
  RepeatableRead
  |
  Serializable
  deriving stock (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, 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
IsolationLevel -> Int
IsolationLevel -> [IsolationLevel]
IsolationLevel -> IsolationLevel
IsolationLevel -> IsolationLevel -> [IsolationLevel]
IsolationLevel
-> IsolationLevel -> IsolationLevel -> [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
forall a. a -> a -> Bounded a
maxBound :: IsolationLevel
$cmaxBound :: IsolationLevel
minBound :: IsolationLevel
$cminBound :: IsolationLevel
Bounded)

data TransactionConfig =
  TransactionConfig {
    TransactionConfig -> IsolationLevel
isolationLevel :: IsolationLevel,
    TransactionConfig -> AccessMode
accessMode :: AccessMode,
    TransactionConfig -> Bool
deferrable :: Bool
  }
  deriving stock (TransactionConfig -> TransactionConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionConfig -> TransactionConfig -> Bool
$c/= :: TransactionConfig -> TransactionConfig -> Bool
== :: TransactionConfig -> TransactionConfig -> Bool
$c== :: TransactionConfig -> TransactionConfig -> Bool
Eq, Int -> TransactionConfig -> ShowS
[TransactionConfig] -> ShowS
TransactionConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionConfig] -> ShowS
$cshowList :: [TransactionConfig] -> ShowS
show :: TransactionConfig -> String
$cshow :: TransactionConfig -> String
showsPrec :: Int -> TransactionConfig -> ShowS
$cshowsPrec :: Int -> TransactionConfig -> ShowS
Show, forall x. Rep TransactionConfig x -> TransactionConfig
forall x. TransactionConfig -> Rep TransactionConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransactionConfig x -> TransactionConfig
$cfrom :: forall x. TransactionConfig -> Rep TransactionConfig x
Generic)

instance Default TransactionConfig where
  def :: TransactionConfig
def =
    TransactionConfig {
      $sel:isolationLevel:TransactionConfig :: IsolationLevel
isolationLevel = IsolationLevel
ReadCommitted,
      $sel:accessMode:TransactionConfig :: AccessMode
accessMode = AccessMode
Write,
      $sel:deferrable:TransactionConfig :: Bool
deferrable = Bool
False
    }

beginTransactionSql :: TransactionConfig -> ByteString
beginTransactionSql :: TransactionConfig -> ByteString
beginTransactionSql TransactionConfig {Bool
IsolationLevel
AccessMode
deferrable :: Bool
accessMode :: AccessMode
isolationLevel :: IsolationLevel
$sel:deferrable:TransactionConfig :: TransactionConfig -> Bool
$sel:accessMode:TransactionConfig :: TransactionConfig -> AccessMode
$sel:isolationLevel:TransactionConfig :: TransactionConfig -> IsolationLevel
..} =
  [exon|start transaction #{isolation isolationLevel} #{mode accessMode} #{defer}|]
  where
    isolation :: IsolationLevel -> ByteString
isolation = \case
      IsolationLevel
ReadCommitted -> ByteString
"isolation level read committed"
      IsolationLevel
RepeatableRead -> ByteString
"isolation level repeatable read"
      IsolationLevel
Serializable -> ByteString
"isolation level serializable"
    mode :: AccessMode -> ByteString
mode = \case
      AccessMode
Write -> ByteString
"read write"
      AccessMode
Read -> ByteString
"read only"
    defer :: ByteString
defer | Bool
deferrable = ByteString
"deferrable"
          | Bool
otherwise = ByteString
""

beginTransaction :: TransactionConfig -> Bool -> Statement () ()
beginTransaction :: TransactionConfig -> Bool -> Statement () ()
beginTransaction TransactionConfig
conf Bool
preparable =
  forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement (TransactionConfig -> ByteString
beginTransactionSql TransactionConfig
conf) Params ()
noParams Result ()
noResult Bool
preparable

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

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