module Hasql.Connection.Setting.Connection
  ( Connection,
    string,
    params,
  )
where

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

-- | Instructions on how to connect to the database.
newtype Connection = Connection ByteString

instance Config.ConnectionString.Constructs Connection where
  construct :: Connection -> ConnectionString
construct = Connection -> ConnectionString
forall a b. Coercible a b => a -> b
coerce

-- | Preconstructed connection string according to <https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-CONNSTRING the PostgreSQL format>.
string :: Text -> Connection
string :: Text -> Connection
string =
  ConnectionString -> Connection
Connection (ConnectionString -> Connection)
-> (Text -> ConnectionString) -> Text -> Connection
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
. Text -> ConnectionString
Config.ConnectionString.fromText

-- | Structured parameters.
params :: [Param.Param] -> Connection
params :: [Param] -> Connection
params =
  ConnectionString -> Connection
Connection (ConnectionString -> Connection)
-> ([Param] -> ConnectionString) -> [Param] -> Connection
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
. Params -> ConnectionString
Config.ConnectionString.fromParams (Params -> ConnectionString)
-> ([Param] -> Params) -> [Param] -> ConnectionString
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
. [Param] -> Params
forall a. Updates a => [a] -> Params
Config.ConnectionString.Params.fromUpdates