tmp-postgres 1.6.0.0 → 1.7.0.0

raw patch · 6 files changed

+41/−25 lines, 6 files

Files

• README.md +1/−0
• src/Database/Postgres/Temp.hs +3/−1
• src/Database/Postgres/Temp/Internal.hs +12/−3
• src/Database/Postgres/Temp/Internal/Core.hs +10/−6
• src/Database/Postgres/Temp/Internal/Partial.hs +14/−13
• tmp-postgres.cabal +1/−2

@@ -1,3 +1,4 @@+[![Hackage](https://img.shields.io/hackage/v/tmp-postgres.svg?style=flat)](https://hackage.haskell.org/package/tmp-postgres) [![Travis CI Status](https://travis-ci.org/jfischoff/tmp-postgres.svg?branch=master)](http://travis-ci.org/jfischoff/tmp-postgres) # tmp-postgres 

@@ -68,10 +68,12 @@   , reloadConfig   -- * DB manipulation   , toConnectionString+  , toConnectionOptions+  , toDataDirectory   -- * Errors   , StartError (..)   -- * Main resource handle-  , DB (..)+  , DB   , prettyPrintDB   -- * Configuration Types   , Config (..)

@@ -39,13 +39,22 @@     <> indent 2 (pretty dbPostgresProcess)  -- | Convert a 'DB' to a connection string. Alternatively one can access the---   'Client.Options' using---    @postgresProcessClientOptions . dbPostgresProcess@+--   'Client.Options' using 'toConnectionOptions' toConnectionString :: DB -> ByteString toConnectionString   = Client.toConnectionString-  . postgresProcessClientOptions+  . toConnectionOptions++-- | Convert a 'DB' to a connection 'Client.Options' type.+toConnectionOptions :: DB -> Client.Options+toConnectionOptions+  = postgresProcessClientOptions   . dbPostgresProcess++-- | Access the data directory. This was either generated or+--   specified explicitly when creating the 'Config'+toDataDirectory :: DB -> FilePath+toDataDirectory =  toFilePath . resourcesDataDir . dbResources ------------------------------------------------------------------------------- -- Life Cycle Management -------------------------------------------------------------------------------

@@ -27,6 +27,8 @@ data Event   = StartPostgres   | WaitForDB+  | StartPlan String+  | TryToConnect   deriving (Show, Eq, Ord)  -- | A list of failures that can occur when starting. This is not@@ -42,7 +44,7 @@   | CreateDbFailed ExitCode   -- ^ @createdb@ failed. This can be from invalid configuration or   --   the database might already exist.-  | CompletePlanFailed [String]+  | CompletePlanFailed String [String]   -- ^ The 'Database.Postgres.Temp.Partial.PartialPlan' was missing info and a complete 'Plan' could   --   not be created.   deriving (Show, Eq, Ord, Typeable)@@ -56,12 +58,13 @@ -- | @postgres@ is not ready until we are able to successfully connect. --   'waitForDB' attempts to connect over and over again and returns --   after the first successful connection.-waitForDB :: Client.Options -> IO ()-waitForDB options = do+waitForDB :: Logger -> Client.Options -> IO ()+waitForDB logger options = do+  logger TryToConnect   let theConnectionString = Client.toConnectionString options       startAction = PG.connectPostgreSQL theConnectionString   try (bracket startAction PG.close mempty) >>= \case-    Left (_ :: IOError) -> threadDelay 10000 >> waitForDB options+    Left (_ :: IOError) -> threadDelay 10000 >> waitForDB logger options     Right () -> return ()  -- | 'ProcessConfig' contains the configuration necessary for starting a@@ -211,7 +214,7 @@             }        -- Block until a connection succeeds or postgres crashes-      waitForDB options+      waitForDB logger options         `race_` forever (checkForCrash >> threadDelay 100000)        -- Postgres is now ready so return@@ -267,7 +270,8 @@ --   the @postgres@ process is ready. See 'startPostgresProcess' for more --   details. startPlan :: Plan -> IO PostgresProcess-startPlan Plan {..} = do+startPlan plan@Plan {..} = do+  planLogger $ StartPlan $ show $ pretty plan   for_ planInitDb  $ executeProcess "initdb" >=>     throwIfNotSuccess InitDbFailed 

@@ -27,7 +27,7 @@ import Network.Socket.Free (getFreePort) import Control.Monad (join) import System.Directory-import Data.Either.Validation+import Control.Applicative.Lift import Control.Monad.Trans.Cont import Control.Monad.Trans.Class import System.IO.Error@@ -191,18 +191,18 @@ addErrorContext cxt = either (Left . map (cxt <>)) Right  -- A helper for creating an error if a 'Last' is not defined.-getOption :: String -> Last a -> Validation [String] a+getOption :: String -> Last a -> Errors [String] a getOption optionName = \case     Last (Just x) -> pure x-    Last Nothing  -> Failure ["Missing " ++ optionName ++ " option"]+    Last Nothing  -> failure ["Missing " ++ optionName ++ " option"]  -- | Turn a 'PartialProcessConfig' into a 'ProcessConfig'. Fails if --   any values are missing. completeProcessConfig   :: [(String, String)] -> PartialProcessConfig -> Either [String] ProcessConfig-completeProcessConfig envs PartialProcessConfig {..} = validationToEither $ do+completeProcessConfig envs PartialProcessConfig {..} = runErrors $ do   let processConfigCmdLine = completeCommandLineArgs partialProcessConfigCmdLine-  processConfigEnvVars <- eitherToValidation $+  processConfigEnvVars <- eitherToErrors $     completePartialEnvVars envs partialProcessConfigEnvVars   processConfigStdIn  <-     getOption "partialProcessConfigStdIn" partialProcessConfigStdIn@@ -377,10 +377,10 @@ -- | Turn a 'PartialPostgresPlan' into a 'PostgresPlan'. Fails if any --   values are missing. completePostgresPlan :: [(String, String)] -> PartialPostgresPlan -> Either [String] PostgresPlan-completePostgresPlan envs PartialPostgresPlan {..} = validationToEither $ do+completePostgresPlan envs PartialPostgresPlan {..} = runErrors $ do   let postgresPlanClientOptions = partialPostgresPlanClientConfig   postgresPlanProcessConfig <--    eitherToValidation $ addErrorContext "partialPostgresPlanProcessConfig: " $+    eitherToErrors $ addErrorContext "partialPostgresPlanProcessConfig: " $       completeProcessConfig envs partialPostgresPlanProcessConfig    pure PostgresPlan {..}@@ -423,13 +423,13 @@  -- | Turn a 'PartialPlan' into a 'Plan'. Fails if any values are missing. completePlan :: [(String, String)] -> PartialPlan -> Either [String] Plan-completePlan envs PartialPlan {..} = validationToEither $ do+completePlan envs PartialPlan {..} = runErrors $ do   planLogger   <- getOption "partialPlanLogger" partialPlanLogger-  planInitDb   <- eitherToValidation $ addErrorContext "partialPlanInitDb: " $+  planInitDb   <- eitherToErrors $ addErrorContext "partialPlanInitDb: " $     traverse (completeProcessConfig envs) partialPlanInitDb-  planCreateDb <- eitherToValidation $ addErrorContext "partialPlanCreateDb: " $+  planCreateDb <- eitherToErrors $ addErrorContext "partialPlanCreateDb: " $     traverse (completeProcessConfig envs) partialPlanCreateDb-  planPostgres <- eitherToValidation $ addErrorContext "partialPlanPostgres: " $+  planPostgres <- eitherToErrors $ addErrorContext "partialPlanPostgres: " $     completePostgresPlan envs partialPlanPostgres   let planConfig = unlines partialPlanConfig   planDataDirectory <- getOption "partialPlanDataDirectory"@@ -579,8 +579,9 @@           resourcesSocket           (toFilePath resourcesDataDir)       finalPlan = hostAndDirPartial <> configPlan-  resourcesPlan <- lift $ either (throwIO . CompletePlanFailed) pure $-    completePlan envs finalPlan+  resourcesPlan <- lift $+    either (throwIO . CompletePlanFailed (show $ pretty finalPlan)) pure $+      completePlan envs finalPlan   pure Resources {..}  -- | Free the temporary resources created by 'setupConfig'

@@ -1,5 +1,5 @@ name:                tmp-postgres-version:             1.6.0.0+version:             1.7.0.0 synopsis: Start and stop a temporary postgres description:  @tmp-postgres@ provides functions creating a temporary @postgres@ instance.@@ -63,7 +63,6 @@                , port-utils                , async                , generic-monoid-               , either                , transformers                , containers                , ansi-wl-pprint