tmp-postgres 1.15.1.1 → 1.16.0.0
raw patch · 5 files changed
+115/−24 lines, 5 files
Files
- CHANGELOG.md +4/−0
- src/Database/Postgres/Temp/Config.hs +5/−0
- src/Database/Postgres/Temp/Internal/Config.hs +99/−17
- src/Database/Postgres/Temp/Internal/Core.hs +6/−6
- tmp-postgres.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,9 @@ Changelog for tmp-postgres +1.16.0.0+ #149 CopyDirectoryCommand partial and rename the old CopyDirectoryCommand to+ CompleteCopyDirectoryCommand.+ 1.15.1.1 #141 Documentation fixes.
src/Database/Postgres/Temp/Config.hs view
@@ -26,6 +26,7 @@ , postgresConfigFileL , createDbConfigL , dataDirectoryStringL+ , copyConfigL , initDbConfigL , loggerL , postgresPlanL@@ -34,6 +35,10 @@ -- *** 'PostgresPlan' lenses , connectionOptionsL , postgresConfigL+ -- ** 'CopyDirectoryCommand'+ , sourceDirectoryL+ , destinationDirectoryL+ , useCopyOnWriteL -- ** 'ProcessConfig' , ProcessConfig (..) -- *** 'ProcessConfig' Lenses
src/Database/Postgres/Temp/Internal/Config.hs view
@@ -392,7 +392,7 @@ ------------------------------------------------------------------------------- -- | Describe how to run @initdb@, @createdb@ and @postgres@ ----- @since 1.12.0.0+-- @since 1.16.0.0 data Plan = Plan { logger :: Last Logger , initDbConfig :: Maybe ProcessConfig@@ -436,20 +436,28 @@ -- | Turn a 'Plan' into a 'CompletePlan'. Fails if any values are missing. completePlan :: [(String, String)] -> Plan -> Either [String] CompletePlan-completePlan envs Plan {..} = runErrors $ do- completePlanLogger <- getOption "logger" logger- completePlanInitDb <- eitherToErrors $ addErrorContext "initDbConfig: " $- traverse (completeProcessConfig envs) initDbConfig- completePlanCopy <- getOption "dataDirectoryString" copyConfig- completePlanCreateDb <- eitherToErrors $ addErrorContext "createDbConfig: " $- traverse (completeProcessConfig envs) createDbConfig- completePlanPostgres <- eitherToErrors $ addErrorContext "postgresPlan: " $- completePostgresPlan envs postgresPlan+completePlan envs Plan {..} = do+ ( completePlanLogger+ , completePlanInitDb+ , completePlanCreateDb+ , completePlanPostgres+ , completePlanDataDirectory+ , completePlanConnectionTimeout+ ) <- runErrors+ $ (,,,,,)+ <$> getOption "logger" logger+ <*> eitherToErrors (addErrorContext "initDbConfig: " $+ traverse (completeProcessConfig envs) initDbConfig)+ <*> eitherToErrors (addErrorContext "createDbConfig: " $+ traverse (completeProcessConfig envs) createDbConfig)+ <*> eitherToErrors (addErrorContext "postgresPlan: "+ (completePostgresPlan envs postgresPlan))+ <*> getOption "dataDirectoryString" dataDirectoryString+ <*> getOption "connectionTimeout" connectionTimeout+ let completePlanConfig = unlines postgresConfigFile- completePlanDataDirectory <- getOption "dataDirectoryString"- dataDirectoryString- completePlanConnectionTimeout <- getOption "connectionTimeout"- connectionTimeout+ completePlanCopy =completeCopyDirectory completePlanDataDirectory <$>+ join (getLast copyConfig) pure CompletePlan {..} @@ -465,7 +473,7 @@ -- | The high level options for overriding default behavior. ----- @since 1.15.0.0+-- @since 1.16.0.0 data Config = Config { plan :: Plan -- ^ Extend or replace any of the configuration used to create a final@@ -518,6 +526,45 @@ ------------------------------------------------------------------------------- -- Caching -------------------------------------------------------------------------------+{-|+Copy command used to create a data directory. If @initdb@ used to create the+data directory directly this is not needed.++If 'destinationDirectory' is Nothing then the 'dataDirectoryString'+(which might be generated) is used.++@since 1.16.0.0+-}+data CopyDirectoryCommand = CopyDirectoryCommand+ { sourceDirectory :: FilePath+ , destinationDirectory :: Maybe FilePath+ , useCopyOnWrite :: Bool+ } deriving (Show, Eq, Ord)++instance Pretty CopyDirectoryCommand where+ pretty CopyDirectoryCommand {..}+ = text "sourceDirectory:"+ <> softline+ <> indent 2 (text sourceDirectory)+ <> hardline+ <> text "destinationDirectory:"+ <> softline+ <> indent 2 (pretty destinationDirectory)+ <> hardline+ <> text "useCopyOnWrite:"+ <+> (pretty useCopyOnWrite)++completeCopyDirectory+ :: FilePath+ -> CopyDirectoryCommand+ -> CompleteCopyDirectoryCommand+completeCopyDirectory theDataDirectory CopyDirectoryCommand {..} =+ CompleteCopyDirectoryCommand+ { copyDirectoryCommandSrc = sourceDirectory+ , copyDirectoryCommandDst = fromMaybe theDataDirectory destinationDirectory+ , copyDirectoryCommandCow = useCopyOnWrite+ }+ getInitDbVersion :: IO String getInitDbVersion = readProcessWithExitCode "initdb" ["--version"] "" >>= \case (ExitSuccess, outputString, _) -> do@@ -549,7 +596,6 @@ let theHash = makeArgumentHash cmdLine pure $ cacheFolder <> "/" <> version <> "/" <> theHash - splitDataDirectory :: CompleteProcessConfig -> (Maybe String, CompleteProcessConfig) splitDataDirectory old = let isDataDirectoryFlag xs = "-D" `isPrefixOf` xs || "--pgdata=" `isPrefixOf` xs@@ -602,7 +648,7 @@ pure $ pure $ addDataDirectory cachedDataDirectory clearedConfig pure plan- { completePlanCopy = pure $ CopyDirectoryCommand+ { completePlanCopy = pure $ CompleteCopyDirectoryCommand { copyDirectoryCommandSrc = cachedDataDirectory , copyDirectoryCommandDst = theDataDirectory , copyDirectoryCommandCow = cow@@ -976,6 +1022,15 @@ (f dataDirectoryString) {-# INLINE dataDirectoryStringL #-} +-- | Lens for 'copyConfig'.+--+-- @since 1.16.0.0+copyConfigL :: Lens' Plan (Last (Maybe CopyDirectoryCommand))+copyConfigL f (plan@Plan{..})+ = fmap (\x -> plan { copyConfig = x })+ (f copyConfig)+{-# INLINE copyConfigL #-}+ -- | Lens for 'initDbConfig'. -- -- @since 1.12.0.0@@ -1107,3 +1162,30 @@ = fmap (`CommandLineArgs` x_amNx) (f_amNv x_amNw) {-# INLINE keyBasedL #-}++-- | Lens for 'sourceDirectory'.+--+-- @since 1.16.0.0+sourceDirectoryL :: Lens' CopyDirectoryCommand FilePath+sourceDirectoryL f (cmd@CopyDirectoryCommand{..})+ = fmap (\x -> cmd { sourceDirectory = x })+ (f sourceDirectory)+{-# INLINE sourceDirectoryL #-}++-- | Lens for 'destinationDirectory'.+--+-- @since 1.16.0.0+destinationDirectoryL :: Lens' CopyDirectoryCommand (Maybe FilePath)+destinationDirectoryL f (cmd@CopyDirectoryCommand{..})+ = fmap (\x -> cmd { destinationDirectory = x })+ (f destinationDirectory)+{-# INLINE destinationDirectoryL #-}++-- | Lens for 'useCopyOnWrite'.+--+-- @since 1.16.0.0+useCopyOnWriteL :: Lens' CopyDirectoryCommand Bool+useCopyOnWriteL f (cmd@CopyDirectoryCommand{..})+ = fmap (\x -> cmd { useCopyOnWrite = x })+ (f useCopyOnWrite)+{-# INLINE useCopyOnWriteL #-}
src/Database/Postgres/Temp/Internal/Core.hs view
@@ -305,14 +305,14 @@ (res, stdOut, stdErr) <- executeProcessAndTee "initdb" config throwIfNotSuccess (InitDbFailed stdOut stdErr) res -data CopyDirectoryCommand = CopyDirectoryCommand+data CompleteCopyDirectoryCommand = CompleteCopyDirectoryCommand { copyDirectoryCommandSrc :: FilePath , copyDirectoryCommandDst :: FilePath , copyDirectoryCommandCow :: Bool } deriving (Show, Eq, Ord) -instance Pretty CopyDirectoryCommand where- pretty CopyDirectoryCommand {..}+instance Pretty CompleteCopyDirectoryCommand where+ pretty CompleteCopyDirectoryCommand {..} = text "copyDirectoryCommandSrc:" <> softline <> indent 2 (text copyDirectoryCommandSrc)@@ -324,8 +324,8 @@ <> text "copyDirectoryCommandCow:" <+> (pretty copyDirectoryCommandCow) -executeCopyDirectoryCommand :: CopyDirectoryCommand -> IO ()-executeCopyDirectoryCommand CopyDirectoryCommand {..} = do+executeCopyDirectoryCommand :: CompleteCopyDirectoryCommand -> IO ()+executeCopyDirectoryCommand CompleteCopyDirectoryCommand {..} = do let #ifdef darwin_HOST_OS cpFlags = if copyDirectoryCommandCow then "cp -Rc " else "cp -R "@@ -347,7 +347,7 @@ data CompletePlan = CompletePlan { completePlanLogger :: Logger , completePlanInitDb :: Maybe CompleteProcessConfig- , completePlanCopy :: Maybe CopyDirectoryCommand+ , completePlanCopy :: Maybe CompleteCopyDirectoryCommand , completePlanCreateDb :: Maybe CompleteProcessConfig , completePlanPostgres :: CompletePostgresPlan , completePlanConfig :: String
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.15.1.1+version: 1.16.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