diff --git a/bench/main.hs b/bench/main.hs index 9099a28..cf7097c 100644 --- a/bench/main.hs +++ b/bench/main.hs @@ -36,8 +36,8 @@ runBenchApp pool m = runSimpleApp $ runSqlPool m pool createBenchPool :: IO ConnectionPool createBenchPool = do loadYamlSettingsArgs [configSettingsYmlValue] useEnv >>= \case - AppSettings{appDatabase = DSPostgres pgString pgPoolSize} -> - runNoLoggingT $ createPostgresqlPool (encodeUtf8 pgString) pgPoolSize + AppSettings{appDatabase = DSPostgres pgString _} -> + runNoLoggingT $ createPostgresqlPool (encodeUtf8 pgString) 1 _ -> throwString "Benchmarks are crafted for PostgreSQL" releasePool :: ConnectionPool -> IO () diff --git a/src/Settings.hs b/src/Settings.hs index 976c5e2..17c76a2 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -56,7 +56,7 @@ data AppSettings = AppSettings } data DatabaseSettings - = DSPostgres !Text !Int + = DSPostgres !Text !(Maybe Int) | DSSqlite !Text !Int parseDatabase diff --git a/src/Stackage/Database/Schema.hs b/src/Stackage/Database/Schema.hs index 9d89587..91c5089 100644 --- a/src/Stackage/Database/Schema.hs +++ b/src/Stackage/Database/Schema.hs @@ -66,6 +66,7 @@ import RIO import RIO.Time import Types (CompilerP(..), FlagNameP, Origin, SnapName, VersionRangeP) import Settings (DatabaseSettings (..)) +import UnliftIO.Concurrent (getNumCapabilities) currentSchema :: Int currentSchema = 1 @@ -197,7 +198,9 @@ withStackageDatabase shouldLog dbs inner = do let makePool :: (MonadUnliftIO m, MonadLogger m) => m (Pool SqlBackend) makePool = case dbs of - DSPostgres connStr size -> createPostgresqlPool (encodeUtf8 connStr) size + DSPostgres connStr mSize -> do + size <- maybe getNumCapabilities pure mSize + createPostgresqlPool (encodeUtf8 connStr) size DSSqlite connStr size -> do pool <- createSqlitePool connStr size runSqlPool (do