fix(users/Profpatsch/whatcd-resolver): SQL formatting off r/8447

It turns out the pg_format thing is just too slow for my use-cases
most of the time, even when pooling the mf. Most queries stay 90%+ in
the perl script, even though they are very fast to execute on their
own, screwing up the traces a lot.

So instead I replace the `postgres-simple` quasi-quoter that strips
whitespace (and tends to screw up queries anyway) with a simple one
that just removes the outer indentation up to the first line.

Why did I spend so much time on pg_format haha

Change-Id: I911cd869deec68aa5cf430ff4d111b0662ec6d28
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12138
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>

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)