diff options
Diffstat (limited to 'users/Profpatsch/whatcd-resolver')
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/AppT.hs | 17 | ||||
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/Redacted.hs | 1 | ||||
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs | 10 |
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 |