maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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>
This commit is contained in:
Profpatsch 2024-08-05 11:11:29 +02:00
parent 3202d008d5
commit 2510cd6a5c
4 changed files with 78 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

17
users/Profpatsch/whatcd-resolver/src/AppT.hs
View file

@ -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)