beam-automigrate-0.1.0.1: bench/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Exception (bracket)
import Control.Monad.IO.Class (liftIO)
import Criterion.Main
import qualified Data.Map.Strict as M
import Database.Beam.AutoMigrate
import Database.Beam.AutoMigrate.BenchUtil
import Database.Beam.AutoMigrate.Postgres (getSchema)
import Database.Beam.Postgres (runBeamPostgres)
import qualified Database.PostgreSQL.Simple as Pg

pgMigrate :: Pg.Connection -> (Schema -> Schema -> Diff) -> Schema -> IO SpineStrict
pgMigrate conn diffFun hsSchema =
  Pg.withTransaction conn $
    runBeamPostgres conn $ do
      dbSchema <- liftIO (getSchema conn)
      pure . SS $ diffFun hsSchema dbSchema

main :: IO ()
main = do
  putStrLn "Generating schema with 10_000 tables ..."
  (hsSchema, dbSchema) <- predictableSchemas 10000
  putStrLn $ "Generated schema with " ++ show (M.size . schemaTables $ hsSchema) ++ " tables."
  bracket (setupDatabase dbSchema) tearDownDatabase $ \pgConn ->
    defaultMain
      [ bgroup
          "diff"
          [ bench "reference/10_000 tables avg. case (similar schema)" $ nf (SS . diffReferenceImplementation hsSchema) dbSchema,
            bench "efficient/10_000 tables avg. case (similar schema)" $ nf (SS . diff hsSchema) dbSchema,
            bench "reference/10_000 tables worst case (no schema)" $ nf (SS . diffReferenceImplementation hsSchema) noSchema,
            bench "efficient/10_000 tables worst case (no schema)" $ nf (SS . diff hsSchema) noSchema
          ],
        bgroup
          "getSchema"
          [ bench "10_000 tables" $ nfIO (getSchema pgConn)
          ],
        bgroup
          "full_migration"
          [ bench "reference/10_000 tables avg. case (similar schema)" $ nfIO (pgMigrate pgConn diffReferenceImplementation hsSchema),
            bench "efficient/10_000 tables avg. case (similar schema)" $ nfIO (pgMigrate pgConn diff hsSchema),
            bench "reference/10_000 tables worst case (no previous schema)" $ nfIO (pgMigrate pgConn diffReferenceImplementation hsSchema),
            bench "efficient/10_000 tables worst case (no previous schema)" $ nfIO (pgMigrate pgConn diff hsSchema)
          ]
      ]