module Hasql.Connection.Setting
  ( Setting,
    connection,
    usePreparedStatements,
  )
where

import Hasql.Connection.Config qualified as Config
import Hasql.Connection.Config.ConnectionString qualified as Config.ConnectionString
import Hasql.Connection.Setting.Connection qualified as Connection
import Hasql.Prelude

-- | Setting of a client handle.
newtype Setting = Setting (Config.Config -> Config.Config)

instance Config.Updates Setting where
  update :: Setting -> Config -> Config
update (Setting Config -> Config
update) = Config -> Config
update

-- | Connection details like address of the remote service and authentication info.
connection :: Connection.Connection -> Setting
connection :: Connection -> Setting
connection =
  (Config -> Config) -> Setting
Setting ((Config -> Config) -> Setting)
-> (Connection -> Config -> Config) -> Connection -> Setting
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Config -> Config
Config.setConnectionString (ByteString -> Config -> Config)
-> (Connection -> ByteString) -> Connection -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Connection -> ByteString
forall a. Constructs a => a -> ByteString
Config.ConnectionString.construct

-- | Whether prepared statements are allowed.
--
-- When 'False', even the statements marked as preparable will be executed without preparation.
--
-- This is useful when dealing with proxying applications like @pgbouncer@, which may be incompatible with prepared statements.
-- Consult their docs or just set it to 'False' to stay on the safe side.
-- It should be noted that starting from version @1.21.0@ @pgbouncer@ now does provide support for prepared statements.
--
-- 'True' by default.
usePreparedStatements :: Bool -> Setting
usePreparedStatements :: Bool -> Setting
usePreparedStatements =
  (Config -> Config) -> Setting
Setting ((Config -> Config) -> Setting)
-> (Bool -> Config -> Config) -> Bool -> Setting
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> Config -> Config
Config.setUsePreparedStatements