Safe Haskell | None |
---|---|
Language | GHC2021 |
Freckle.App.Database
Description
Database access for your App
Synopsis
- class (MonadSqlBackend db, MonadUnliftIO m) => MonadSqlTx (db :: Type -> Type) (m :: Type -> Type) | m -> db where
- runSqlTx :: HasCallStack => db a -> m a
- runDB :: (MonadUnliftIO m, MonadTracer m, MonadReader app m, HasSqlPool app, HasStatsClient app, HasCallStack) => SqlPersistT m a -> m a
- runDBSimple :: (HasSqlPool app, MonadUnliftIO m, MonadReader app m) => SqlPersistT m a -> m a
- data SqlBackend
- class HasSqlBackend a where
- getSqlBackend :: a -> SqlBackend
- class MonadUnliftIO m => MonadSqlBackend (m :: Type -> Type) where
- getSqlBackendM :: m SqlBackend
- liftSql :: (MonadSqlBackend m, HasCallStack) => ReaderT SqlBackend m a -> m a
- class Monad m => MonadTracer (m :: Type -> Type)
- class HasStatsClient env
- class HasSqlPool app where
- getSqlPool :: app -> SqlPool
- type SqlPool = Pool SqlBackend
- makePostgresPool :: (MonadUnliftIO m, MonadLoggerIO m) => m SqlPool
- makePostgresPoolWith :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConnectionConf -> m SqlPool
- data PostgresConnectionConf = PostgresConnectionConf {}
- data PostgresPasswordSource
- data PostgresPassword
- type PostgresStatementTimeout = Timeout
- postgresStatementTimeoutMilliseconds :: PostgresStatementTimeout -> Int
- envParseDatabaseConf :: PostgresPasswordSource -> Parser Error PostgresConnectionConf
- envPostgresPasswordSource :: Parser Error PostgresPasswordSource
Running transactions
class (MonadSqlBackend db, MonadUnliftIO m) => MonadSqlTx (db :: Type -> Type) (m :: Type -> Type) | m -> db where #
The constraint
indicates that MonadSqlTx
db mm
is a monadic
context that can run db
actions, usually as a SQL transaction.
Typically, this means that db
needs a connection and m
can
provide one, e.g. from a connection pool.
Instances
(HasSqlPool app, HasStatsClient app, HasTracer app) => MonadSqlTx (SqlPersistT (AppExample app)) (AppExample app) Source # | |
Defined in Freckle.App.Test Methods runSqlTx :: HasCallStack => SqlPersistT (AppExample app) a -> AppExample app a # | |
(MonadUnliftIO m, HasSqlPool app, HasStatsClient app, HasTracer app) => MonadSqlTx (ReaderT SqlBackend (AppT app m)) (AppT app m) Source # | |
Defined in Freckle.App Methods runSqlTx :: HasCallStack => ReaderT SqlBackend (AppT app m) a -> AppT app m a # |
runDB :: (MonadUnliftIO m, MonadTracer m, MonadReader app m, HasSqlPool app, HasStatsClient app, HasCallStack) => SqlPersistT m a -> m a Source #
Run a Database action with connection stats and tracing
This uses OpenTelemetry and MonadTracer
. For callstacks in traces to be
useful, ensure you have HasCallStack
on functions that call this (and
functions that call those, for as far as you require to get to a useful
source location).
runDBSimple :: (HasSqlPool app, MonadUnliftIO m, MonadReader app m) => SqlPersistT m a -> m a Source #
Running queries
data SqlBackend #
A SqlBackend
represents a handle or connection to a database. It
contains functions and values that allow databases to have more
optimized implementations, as well as references that benefit
performance and sharing.
Instead of using the SqlBackend
constructor directly, use the
mkSqlBackend
function.
A SqlBackend
is *not* thread-safe. You should not assume that
a SqlBackend
can be shared among threads and run concurrent queries.
This *will* result in problems. Instead, you should create a
, known as a Pool
SqlBackend
ConnectionPool
, and pass that around in
multi-threaded applications.
To run actions in the persistent
library, you should use the
runSqlConn
function. If you're using a multithreaded application, use
the runSqlPool
function.
Instances
class HasSqlBackend a where #
Methods
getSqlBackend :: a -> SqlBackend #
Instances
HasSqlBackend SqlBackend | |
Defined in Database.Persist.Sql.Lifted.HasSqlBackend Methods getSqlBackend :: SqlBackend -> SqlBackend # |
class MonadUnliftIO m => MonadSqlBackend (m :: Type -> Type) where #
A monadic context in which a SQL backend is available for running database queries
Methods
getSqlBackendM :: m SqlBackend #
Instances
(HasSqlBackend r, MonadUnliftIO m) => MonadSqlBackend (ReaderT r m) | |
Defined in Database.Persist.Sql.Lifted.MonadSqlBackend Methods getSqlBackendM :: ReaderT r m SqlBackend # |
liftSql :: (MonadSqlBackend m, HasCallStack) => ReaderT SqlBackend m a -> m a #
Generalize from SqlPersistT
to MonadSqlBackend
Telemetry
class Monad m => MonadTracer (m :: Type -> Type) #
This is generally scoped by Monad stack to do different things
Minimal complete definition
Instances
HasTracer app => MonadTracer (AppExample app) Source # | |
Defined in Freckle.App.Test Methods getTracer :: AppExample app Tracer # | |
(Monad m, HasTracer app) => MonadTracer (AppT app m) Source # | |
Defined in Freckle.App | |
MonadTracer m => MonadTracer (IdentityT m) | |
Defined in OpenTelemetry.Trace.Monad | |
MonadTracer m => MonadTracer (ReaderT r m) | |
Defined in OpenTelemetry.Trace.Monad |
class HasStatsClient env #
Minimal complete definition
statsClientL
Instances
HasStatsClient StatsClient | |
Defined in Freckle.App.Stats Methods statsClientL :: Lens' StatsClient StatsClient |
Connection pools
class HasSqlPool app where Source #
Methods
getSqlPool :: app -> SqlPool Source #
Instances
HasSqlPool SqlPool Source # | |
Defined in Freckle.App.Database Methods getSqlPool :: SqlPool -> SqlPool Source # | |
HasSqlPool site => HasSqlPool (HandlerData child site) Source # | |
Defined in Freckle.App.Database Methods getSqlPool :: HandlerData child site -> SqlPool Source # |
type SqlPool = Pool SqlBackend Source #
makePostgresPool :: (MonadUnliftIO m, MonadLoggerIO m) => m SqlPool Source #
makePostgresPoolWith :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConnectionConf -> m SqlPool Source #
Setup
data PostgresConnectionConf Source #
Constructors
PostgresConnectionConf | |
Fields
|
Instances
Show PostgresConnectionConf Source # | |
Defined in Freckle.App.Database Methods showsPrec :: Int -> PostgresConnectionConf -> ShowS # show :: PostgresConnectionConf -> String # showList :: [PostgresConnectionConf] -> ShowS # | |
Eq PostgresConnectionConf Source # | |
Defined in Freckle.App.Database Methods (==) :: PostgresConnectionConf -> PostgresConnectionConf -> Bool # (/=) :: PostgresConnectionConf -> PostgresConnectionConf -> Bool # |
data PostgresPasswordSource Source #
Instances
Show PostgresPasswordSource Source # | |
Defined in Freckle.App.Database Methods showsPrec :: Int -> PostgresPasswordSource -> ShowS # show :: PostgresPasswordSource -> String # showList :: [PostgresPasswordSource] -> ShowS # | |
Eq PostgresPasswordSource Source # | |
Defined in Freckle.App.Database Methods (==) :: PostgresPasswordSource -> PostgresPasswordSource -> Bool # (/=) :: PostgresPasswordSource -> PostgresPasswordSource -> Bool # |
data PostgresPassword Source #
Constructors
PostgresPasswordIamAuth | |
PostgresPasswordStatic String |
Instances
Show PostgresPassword Source # | |
Defined in Freckle.App.Database Methods showsPrec :: Int -> PostgresPassword -> ShowS # show :: PostgresPassword -> String # showList :: [PostgresPassword] -> ShowS # | |
Eq PostgresPassword Source # | |
Defined in Freckle.App.Database Methods (==) :: PostgresPassword -> PostgresPassword -> Bool # (/=) :: PostgresPassword -> PostgresPassword -> Bool # |
type PostgresStatementTimeout = Timeout Source #