tmp-postgres 1.19.0.1 → 1.20.0.0
raw patch · 6 files changed
+80/−52 lines, 6 files
Files
- CHANGELOG.md +4/−0
- benchmark/Main.hs +9/−10
- src/Database/Postgres/Temp.hs +5/−1
- src/Database/Postgres/Temp/Internal.hs +59/−36
- test/Main.hs +2/−4
- tmp-postgres.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,9 @@ Changelog for tmp-postgres +1.20.0.0+ #144 Make a CacheResources type+ #162 Make a Snapshot alias+ 1.19.0.1 #146 Better version hashing for making cache directories Documentation fixes
benchmark/Main.hs view
@@ -43,7 +43,7 @@ bracket (PG.connectPostgreSQL theConnectionString) PG.close $ \conn -> void $ PG.execute_ conn "INSERT INTO foo1 (id) VALUES (1)" -setupCache :: IO (Bool, CompleteDirectoryType)+setupCache :: IO CacheResources setupCache = do cacheInfo <- setupInitDbCache defaultCacheConfig void (withConfig (silentConfig <> toCacheConfig cacheInfo) (const $ pure ()))@@ -52,7 +52,7 @@ setupWithCache :: (Config -> Benchmark) -> Benchmark setupWithCache f = envWithCleanup setupCache cleanupInitDbCache $ f . (silentConfig <>) . toCacheConfig -setupCacheAndSP :: IO ((Bool, CompleteDirectoryType), CompleteDirectoryType, Once Config)+setupCacheAndSP :: IO (CacheResources, Snapshot, Once Config) setupCacheAndSP = do cacheInfo <- setupCache let cacheConfig = silentConfig <> toCacheConfig cacheInfo@@ -60,19 +60,18 @@ migrateDb db either throwIO pure =<< takeSnapshot Temporary db - snapshotConfig <- (silentConfig <>)- <$> configFromSavePoint (toFilePath sp)- let theConfig = snapshotConfig <> cacheConfig+ let theConfig = silentConfig <> snapshotConfig sp <> cacheConfig + pure (cacheInfo, sp, Once theConfig) -cleanupCacheAndSP :: ((Bool, CompleteDirectoryType), CompleteDirectoryType, Once Config) -> IO ()+cleanupCacheAndSP :: (CacheResources, Snapshot, Once Config) -> IO () cleanupCacheAndSP (x, y, _) = cleanupSnapshot y >> cleanupInitDbCache x setupWithCacheAndSP :: (Config -> Benchmark) -> Benchmark setupWithCacheAndSP f = envWithCleanup setupCacheAndSP cleanupCacheAndSP $ \ ~(_, _, Once x) -> f x -setupWithCacheAndSP' :: (CompleteDirectoryType -> Benchmark) -> Benchmark+setupWithCacheAndSP' :: (Snapshot -> Benchmark) -> Benchmark setupWithCacheAndSP' f = envWithCleanup setupCacheAndSP cleanupCacheAndSP $ \ ~(_, x, _) -> f x main :: IO ()@@ -100,13 +99,13 @@ , setupWithCache $ \cacheConfig -> bench "withSnapshot migrate 10x and cache" $ whnfIO $ withConfig cacheConfig $ \db -> do migrateDb db void $ withSnapshot Temporary db $ \snapshotDir -> do- snapshotConfig <- (silentConfig <>) <$> configFromSavePoint (toFilePath snapshotDir)- replicateM_ 10 $ withConfig snapshotConfig testQuery+ let theSnapshotConfig = silentConfig <> snapshotConfig snapshotDir+ replicateM_ 10 $ withConfig theSnapshotConfig testQuery {- , setupWithCacheAndSP $ \theConfig -> bench "withConfig pre-setup with withSnapshot" $ whnfIO $ void $ withConfig theConfig $ const $ pure () - , setupWithCacheAndSP' $ \sp -> bench "configFromSavePoint" $ whnfIO $ void $ configFromSavePoint $ toFilePath sp+ , setupWithCacheAndSP' $ \sp -> bench "snapshotConfig" $ whnfIO $ void $ snapshotConfig $ toFilePath sp , bench "migrateDb" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig silentConfig) (stop . unOnce) $ \ ~(Once db) -> migrateDb db
src/Database/Postgres/Temp.hs view
@@ -76,6 +76,10 @@ , reloadConfig -- ** 'DB' debugging , prettyPrintDB+ -- ** 'Snapshot' handle+ , Snapshot+ -- ** @initdb@ cache handle+ , CacheResources -- * Errors , StartError (..) -- * Configuration@@ -86,7 +90,7 @@ , silentConfig , silentProcessConfig , defaultCacheConfig- , configFromSavePoint+ , snapshotConfig -- ** Custom Config builder helpers , optionsToDefaultConfig -- ** Configuration Types
src/Database/Postgres/Temp/Internal.hs view
@@ -8,6 +8,7 @@ import Database.Postgres.Temp.Internal.Core import Database.Postgres.Temp.Internal.Config +import Control.DeepSeq import Control.Exception import Control.Monad (void) import Control.Monad.Trans.Cont@@ -15,6 +16,7 @@ import qualified Data.Map.Strict as Map import qualified Database.PostgreSQL.Simple as PG import qualified Database.PostgreSQL.Simple.Options as Client+import GHC.Generics import System.Exit (ExitCode(..)) import System.IO.Unsafe (unsafePerformIO) import System.Process@@ -442,7 +444,7 @@ {-| Configuration for the @initdb@ data directory cache. -@since 1.15.1.0+@since 1.20.0.0 -} data CacheConfig = CacheConfig { cacheTemporaryDirectory :: FilePath@@ -459,6 +461,19 @@ -- and sets this to 'True' if it does. } +{-|+A handle to cache temporary resources and configuration.++@since 1.20.0.0+-}+data CacheResources = CacheResources+ { cacheResourcesCow :: Bool+ , cacheResourcesDirectory :: CompleteDirectoryType+ } deriving stock (Generic)+ deriving anyclass (NFData)++-- | A bool that is 'True' if the @cp@ on the path supports \"copy on write\"+-- flags. cowCheck :: Bool cowCheck = unsafePerformIO $ do let@@ -493,11 +508,10 @@ , cacheUseCopyOnWrite = cowCheck } - -- | Setup the @initdb@ cache folder. setupInitDbCache :: CacheConfig- -> IO (Bool, CompleteDirectoryType)+ -> IO CacheResources setupInitDbCache CacheConfig {..} = bracketOnError (setupDirectoryType@@ -505,15 +519,15 @@ "tmp-postgres-cache" cacheDirectoryType )- cleanupDirectoryType $ pure . (cacheUseCopyOnWrite,)+ cleanupDirectoryType $ pure . CacheResources cacheUseCopyOnWrite {-| Cleanup the cache directory if it was 'Temporary'. -@since 1.15.1.0+@since 1.20.0.0 -}-cleanupInitDbCache :: (Bool, CompleteDirectoryType) -> IO ()-cleanupInitDbCache = cleanupDirectoryType . snd+cleanupInitDbCache :: CacheResources -> IO ()+cleanupInitDbCache = cleanupDirectoryType . cacheResourcesDirectory {-| Enable @initdb@ data directory caching. This can lead to a 4x speedup.@@ -524,12 +538,12 @@ 'withDbCacheConfig' = bracket ('setupInitDbCache' config) 'cleanupInitDbCache' @ -@since 1.15.1.0+@since 1.20.0.0 -} withDbCacheConfig :: CacheConfig -- ^ Configuration- -> ((Bool, CompleteDirectoryType) -> IO a)+ -> (CacheResources -> IO a) -- ^ action for which caching is enabled -> IO a withDbCacheConfig config =@@ -539,35 +553,45 @@ Equivalent to 'withDbCacheConfig' with the 'CacheConfig' 'defaultCacheConfig' makes. -@since 1.15.1.0+@since 1.20.0.0 -}-withDbCache :: ((Bool, CompleteDirectoryType) -> IO a) -> IO a+withDbCache :: (CacheResources -> IO a) -> IO a withDbCache = withDbCacheConfig defaultCacheConfig {-| Helper to make a 'Config' out of caching info. -@since 1.15.1.0+@since 1.20.0.0 -}-toCacheConfig :: (Bool, CompleteDirectoryType) -> Config-toCacheConfig cacheInfo = mempty- { initDbCache = pure $ pure $ fmap toFilePath cacheInfo+toCacheConfig :: CacheResources -> Config+toCacheConfig CacheResources {..} = mempty+ { initDbCache = pure $ pure+ (cacheResourcesCow, toFilePath cacheResourcesDirectory) } ------------------------------------------------------------------------------- -- withSnapshot -------------------------------------------------------------------------------+{-|+A type to track a possibly temporary snapshot directory++@since 1.20.0.0+-}+newtype Snapshot = Snapshot { unSnapshot :: CompleteDirectoryType }+ deriving stock (Generic)+ deriving anyclass (NFData)+ {- | Shutdown the database and copy the directory to a folder. -@since 1.17.0.0+@since 1.20.0.0 -} takeSnapshot :: DirectoryType -- ^ Either a 'Temporary' or preexisting 'Permanent' directory. -> DB -- ^ The handle. The @postgres@ is shutdown and the data directory is copied.- -> IO (Either StartError CompleteDirectoryType)+ -> IO (Either StartError Snapshot) takeSnapshot directoryType db = try $ do throwIfNotSuccess id =<< stopPostgresGracefully db let@@ -588,15 +612,15 @@ throwIfNotSuccess (SnapshotCopyFailed snapshotCopyCmd) =<< system snapshotCopyCmd - pure snapShotDir+ pure $ Snapshot snapShotDir {-| Cleanup any temporary resources used for the snapshot. -@since 1.17.0.0+@since 1.20.0.0 -}-cleanupSnapshot :: CompleteDirectoryType -> IO ()-cleanupSnapshot = cleanupDirectoryType+cleanupSnapshot :: Snapshot -> IO ()+cleanupSnapshot = cleanupDirectoryType . unSnapshot {- | Exception safe method for taking a file system level copy of the database cluster.@@ -604,12 +628,12 @@ Snapshots are useful if you would like to start every test from a migrated database and the migration process is more time consuming then copying the additional data. -@since 1.17.0.0+@since 1.20.0.0 -} withSnapshot :: DirectoryType -> DB- -> (CompleteDirectoryType -> IO a)+ -> (Snapshot -> IO a) -> IO (Either StartError a) withSnapshot dirType db f = bracket (takeSnapshot dirType db)@@ -620,17 +644,16 @@ Convert a snapshot into a 'Config' that includes a 'copyConfig' for copying the snapshot directory to a temporary directory. -@since 1.17.0.0+@since 1.20.0.0 -}-configFromSavePoint :: FilePath -> IO Config-configFromSavePoint savePointPath = do- pure mempty- { plan = mempty- { copyConfig = pure $ pure CopyDirectoryCommand- { sourceDirectory = savePointPath- , destinationDirectory = Nothing- , useCopyOnWrite = cowCheck- }- , initDbConfig = Zlich- }- }+snapshotConfig :: Snapshot -> Config+snapshotConfig (Snapshot savePointPath) = mempty+ { plan = mempty+ { copyConfig = pure $ pure CopyDirectoryCommand+ { sourceDirectory = toFilePath savePointPath+ , destinationDirectory = Nothing+ , useCopyOnWrite = cowCheck+ }+ , initDbConfig = Zlich+ }+ }
test/Main.hs view
@@ -567,10 +567,8 @@ void $ PG.execute_ conn "INSERT INTO foo (id) VALUES (1); END;" either throwIO pure <=< withSnapshot Temporary db $ \snapshotDir -> do- snapshotConfig <- (defaultConfig <>)- <$> configFromSavePoint (toFilePath snapshotDir)-- let snapshotConfigAndAssert = ConfigAndAssertion snapshotConfig $ flip withConn $ \conn -> do+ let theSnapshotConfig = defaultConfig <> snapshotConfig snapshotDir+ snapshotConfigAndAssert = ConfigAndAssertion theSnapshotConfig $ flip withConn $ \conn -> do oneAgain <- fmap (PG.fromOnly . head) $ PG.query_ conn "SELECT id FROM foo" oneAgain `shouldBe` (1 :: Int)
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.19.0.1+version: 1.20.0.0 synopsis: Start and stop a temporary postgres description: Start and stop a temporary postgres. See README.md homepage: https://github.com/jfischoff/tmp-postgres#readme