effectful-postgresql
Safe HaskellNone
LanguageHaskell2010

Effectful.PostgreSQL

Synopsis

Effect

data WithConnection (a :: Type -> Type) b where Source #

A dynamic effect that lets us use a database Connection, without specifying how that connection is supplied.

For example, we might want to just provide a connection and let the interpreter use that for the whole procedure (see runWithConnection).

Or, we might want to create a connection pool which provides connections when the interpreter asks for them (see Effectful.PostgreSQL.Connection.Pool).

Constructors

WithConnection :: forall (a :: Type -> Type) b. (Connection -> a b) -> WithConnection a b

Use a Connection provided by an interpreter.

Instances

Instances details
type DispatchOf WithConnection Source # 
Instance details

Defined in Effectful.PostgreSQL.Connection

withConnection :: forall a (es :: [Effect]). (HasCallStack, WithConnection :> es) => (Connection -> Eff es a) -> Eff es a Source #

Perform the operation WithConnection.

Interpreters

runWithConnection :: forall (es :: [(Type -> Type) -> Type -> Type]) a. HasCallStack => Connection -> Eff (WithConnection ': es) a -> Eff es a Source #

Run a WithConnection effect by simply supplying a Connection. The connection will be kept alive for the whole duration of the procedure, which might not be want you want for long-running processes. If so, see Effectful.PostgreSQL.Connection.Pool.

runWithConnectionPool :: forall (es :: [Effect]) a. (HasCallStack, IOE :> es) => Pool Connection -> Eff (WithConnection ': es) a -> Eff es a Source #

Rather than keeping one connection alive and re-using it for the whole process, we might want to create a Pool of connections and only "ask" for one when we need it. This function uses UnliftIO.Pool to do just that.

Lifted versions of functions from Database.PostgreSQL.Simple

Queries that return results

query :: forall (es :: [Effect]) q r. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q, FromRow r) => Query -> q -> Eff es [r] Source #

Lifted query.

query_ :: forall (es :: [Effect]) r. (HasCallStack, WithConnection :> es, IOE :> es, FromRow r) => Query -> Eff es [r] Source #

Lifted query_.

queryWith :: forall (es :: [Effect]) q r. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q) => RowParser r -> Query -> q -> Eff es [r] Source #

Lifted queryWith.

queryWith_ :: forall (es :: [Effect]) r. (HasCallStack, WithConnection :> es, IOE :> es) => RowParser r -> Query -> Eff es [r] Source #

Lifted queryWith_.

Statements that do not return results

execute :: forall (es :: [Effect]) q. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q) => Query -> q -> Eff es Int64 Source #

Lifted execute.

execute_ :: forall (es :: [Effect]). (HasCallStack, WithConnection :> es, IOE :> es) => Query -> Eff es Int64 Source #

Lifted execute_.

executeMany :: forall (es :: [Effect]) q. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q) => Query -> [q] -> Eff es Int64 Source #

Lifted executeMany.

Transaction handling

withTransaction :: forall (es :: [Effect]) a. (HasCallStack, WithConnection :> es, IOE :> es) => Eff es a -> Eff es a Source #

withSavepoint :: forall (es :: [Effect]) a. (HasCallStack, WithConnection :> es, IOE :> es) => Eff es a -> Eff es a Source #

begin :: forall (es :: [Effect]). (HasCallStack, WithConnection :> es, IOE :> es) => Eff es () Source #

Lifted begin.

commit :: forall (es :: [Effect]). (HasCallStack, WithConnection :> es, IOE :> es) => Eff es () Source #

Lifted commit.

rollback :: forall (es :: [Effect]). (HasCallStack, WithConnection :> es, IOE :> es) => Eff es () Source #

Lifted rollback.

Queries that stream results

fold :: forall (es :: [Effect]) row params a. (HasCallStack, WithConnection :> es, IOE :> es, FromRow row, ToRow params) => Query -> params -> a -> (a -> row -> Eff es a) -> Eff es a Source #

Lifted fold.

foldWithOptions :: forall (es :: [Effect]) row params a. (HasCallStack, WithConnection :> es, IOE :> es, FromRow row, ToRow params) => FoldOptions -> Query -> params -> a -> (a -> row -> Eff es a) -> Eff es a Source #

fold_ :: forall (es :: [Effect]) row a. (HasCallStack, WithConnection :> es, IOE :> es, FromRow row) => Query -> a -> (a -> row -> Eff es a) -> Eff es a Source #

Lifted fold_.

foldWithOptions_ :: forall (es :: [Effect]) row a. (HasCallStack, WithConnection :> es, IOE :> es, FromRow row) => FoldOptions -> Query -> a -> (a -> row -> Eff es a) -> Eff es a Source #

forEach :: forall (es :: [Effect]) r q. (HasCallStack, WithConnection :> es, IOE :> es, FromRow r, ToRow q) => Query -> q -> (r -> Eff es ()) -> Eff es () Source #

Lifted forEach.

forEach_ :: forall (es :: [Effect]) r. (HasCallStack, WithConnection :> es, IOE :> es, FromRow r) => Query -> (r -> Eff es ()) -> Eff es () Source #

Lifted forEach_.

returning :: forall (es :: [Effect]) q r. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q, FromRow r) => Query -> [q] -> Eff es [r] Source #

Lifted returning.

foldWith :: forall (es :: [Effect]) params row a. (HasCallStack, WithConnection :> es, IOE :> es, ToRow params) => RowParser row -> Query -> params -> a -> (a -> row -> Eff es a) -> Eff es a Source #

Lifted foldWith.

foldWithOptionsAndParser :: forall (es :: [Effect]) params row a. (HasCallStack, WithConnection :> es, IOE :> es, ToRow params) => FoldOptions -> RowParser row -> Query -> params -> a -> (a -> row -> Eff es a) -> Eff es a Source #

foldWith_ :: forall (es :: [Effect]) row a. (HasCallStack, WithConnection :> es, IOE :> es) => RowParser row -> Query -> a -> (a -> row -> Eff es a) -> Eff es a Source #

Lifted foldWith_.

foldWithOptionsAndParser_ :: forall (es :: [Effect]) row a. (HasCallStack, WithConnection :> es, IOE :> es) => FoldOptions -> RowParser row -> Query -> a -> (a -> row -> Eff es a) -> Eff es a Source #

forEachWith :: forall (es :: [Effect]) q r. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q) => RowParser r -> Query -> q -> (r -> Eff es ()) -> Eff es () Source #

Lifted forEachWith.

forEachWith_ :: forall (es :: [Effect]) r. (HasCallStack, WithConnection :> es, IOE :> es) => RowParser r -> Query -> (r -> Eff es ()) -> Eff es () Source #

Lifted forEachWith_.

returningWith :: forall (es :: [Effect]) q r. (HasCallStack, WithConnection :> es, IOE :> es, ToRow q) => RowParser r -> Query -> [q] -> Eff es [r] Source #