about summary refs log tree commit diff
path: root/users/Profpatsch/whatcd-resolver/src/AppT.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/Profpatsch/whatcd-resolver/src/AppT.hs')
-rw-r--r--users/Profpatsch/whatcd-resolver/src/AppT.hs17
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)