diff options
Diffstat (limited to 'users/Profpatsch/whatcd-resolver/src/AppT.hs')
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/AppT.hs | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs index 4363e2dbb298..f1015f27ebe0 100644 --- a/users/Profpatsch/whatcd-resolver/src/AppT.hs +++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs @@ -25,7 +25,7 @@ import UnliftIO import Prelude hiding (span) data Context = Context - { config :: Label "logDatabaseQueries" DebugLogDatabaseQueries, + { config :: T2 "logDatabaseQueries" DebugLogDatabaseQueries "prettyPrintDatabaseQueries" PrettyPrintDatabaseQueries, tracer :: Otel.Tracer, pgFormat :: PgFormatPool, pgConnPool :: Pool Postgres.Connection, @@ -40,7 +40,7 @@ newtype AppException = AppException Text deriving anyclass (Exception) instance Show AppException where - showsPrec _ (AppException t) = ("AppException: "++) . (textToString t++) + showsPrec _ (AppException t) = ("AppException: " ++) . (textToString t ++) -- * Logging & Opentelemetry @@ -147,15 +147,18 @@ recordException span dat = liftIO $ do -- * Postgres instance (MonadThrow m, MonadUnliftIO m) => MonadPostgres (AppT m) where - execute = executeImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries)) - executeMany = executeManyImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries)) - executeManyReturningWith = executeManyReturningWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries)) - queryWith = queryWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries)) + execute = executeImpl (AppT ask) dbConfig + executeMany = executeManyImpl (AppT ask) dbConfig + executeManyReturningWith = executeManyReturningWithImpl (AppT ask) dbConfig + queryWith = queryWithImpl (AppT ask) dbConfig queryWith_ = queryWithImpl_ (AppT ask) - foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries)) + foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) dbConfig runTransaction = runPGTransaction +dbConfig :: (Monad m) => AppT m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) +dbConfig = AppT $ asks (\c -> (c.config.logDatabaseQueries, c.config.prettyPrintDatabaseQueries)) + runPGTransaction :: (MonadUnliftIO m) => Transaction (AppT m) a -> AppT m a runPGTransaction (Transaction transaction) = do pool <- AppT ask <&> (.pgConnPool) |