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>

3 files changed, 18 insertions, 10 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)
diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
index 2979b4400a2d..6cdb22273fad 100644
--- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
@@ -12,7 +12,6 @@ import Data.Aeson.KeyMap qualified as KeyMap
 import Data.Error.Tree
 import Data.List qualified as List
 import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
-import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
 import FieldParser qualified as Field
 import Http qualified
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index bfbb49684ce1..d3219be9164b 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -18,7 +18,6 @@ import Data.Map.Strict qualified as Map
 import Data.Pool qualified as Pool
 import Data.Text qualified as Text
 import Database.PostgreSQL.Simple qualified as Postgres
-import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
 import Database.Postgres.Temp qualified as TmpPg
 import FieldParser (FieldParser, FieldParser' (..))
@@ -778,7 +777,14 @@ runAppWith :: AppT IO a -> IO (Either TmpPg.StartError a)
 runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
   tool <- readTools (label @"toolsEnvVar" "WHATCD_RESOLVER_TOOLS") (readTool "pg_format")
   pgFormat <- initPgFormatPool (label @"pgFormat" tool)
-  let config = label @"logDatabaseQueries" LogDatabaseQueries
+  prettyPrintDatabaseQueries <-
+    Env.lookupEnv "WHATCD_RESOLVER_PRETTY_PRINT_DATABASE_QUERIES" <&> \case
+      Just _ -> PrettyPrintDatabaseQueries
+      Nothing -> DontPrettyPrintDatabaseQueries
+  let config =
+        T2
+          (label @"logDatabaseQueries" LogDatabaseQueries)
+          (label @"prettyPrintDatabaseQueries" prettyPrintDatabaseQueries)
   pgConnPool <-
     Pool.newPool $
       Pool.defaultPoolConfig