diff --git a/Changelog.markdown b/Changelog.markdown --- a/Changelog.markdown +++ b/Changelog.markdown @@ -1,5 +1,8 @@ # Changelog +## 0.1.7.0 +* Propagate migration and validation result to application exit code + ## 0.1.6.0 * Support for GHC 8 diff --git a/postgresql-simple-migration.cabal b/postgresql-simple-migration.cabal --- a/postgresql-simple-migration.cabal +++ b/postgresql-simple-migration.cabal @@ -1,5 +1,5 @@ name: postgresql-simple-migration -version: 0.1.6.0 +version: 0.1.7.0 synopsis: PostgreSQL Schema Migrations homepage: https://github.com/ameingast/postgresql-simple-migration Bug-reports: https://github.com/ameingast/postgresql-simple-migration/issues @@ -35,7 +35,7 @@ Database.PostgreSQL.Simple.Util hs-source-dirs: src ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns - default-extensions: OverloadedStrings, CPP + default-extensions: OverloadedStrings, CPP, LambdaCase default-language: Haskell2010 build-depends: base >= 4.6 && < 5.0, base64-bytestring >= 1.0 && < 1.1, @@ -49,7 +49,7 @@ main-is: Main.hs hs-source-dirs: src ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns - default-extensions: OverloadedStrings, CPP + default-extensions: OverloadedStrings, CPP, LambdaCase default-language: Haskell2010 build-depends: base >= 4.6 && < 5.0, base64-bytestring >= 1.0 && < 1.1, @@ -64,7 +64,7 @@ main-is: Main.hs hs-source-dirs: test ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns - default-extensions: OverloadedStrings, CPP + default-extensions: OverloadedStrings, CPP, LambdaCase default-language: Haskell2010 type: exitcode-stdio-1.0 build-depends: base >= 4.6 && < 5.0, diff --git a/src/Database/PostgreSQL/Simple/Migration.hs b/src/Database/PostgreSQL/Simple/Migration.hs --- a/src/Database/PostgreSQL/Simple/Migration.hs +++ b/src/Database/PostgreSQL/Simple/Migration.hs @@ -12,6 +12,7 @@ -- For usage, see Readme.markdown. {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Database.PostgreSQL.Simple.Migration @@ -101,7 +102,7 @@ executeMigration :: Connection -> Bool -> ScriptName -> BS.ByteString -> IO (MigrationResult String) executeMigration con verbose name contents = do let checksum = md5Hash contents - checkScript con name checksum >>= \r -> case r of + checkScript con name checksum >>= \case ScriptOk -> do when verbose $ putStrLn $ "Ok:\t" ++ name return MigrationSuccess @@ -155,7 +156,7 @@ return MigrationSuccess where validate name contents = - checkScript con name (md5Hash contents) >>= \r -> case r of + checkScript con name (md5Hash contents) >>= \case ScriptOk -> do when verbose $ putStrLn $ "Ok:\t" ++ name return MigrationSuccess @@ -167,9 +168,8 @@ return (MigrationError $ "Checksum mismatch: " ++ name) goScripts _ [] = return MigrationSuccess - goScripts path (x:xs) = do - r <- validate x =<< BS.readFile (path ++ "/" ++ x) - case r of + goScripts path (x:xs) = + (validate x =<< BS.readFile (path ++ "/" ++ x)) >>= \case e@(MigrationError _) -> return e MigrationSuccess -> @@ -182,7 +182,7 @@ -- will be executed and its meta-information will be recorded. checkScript :: Connection -> ScriptName -> Checksum -> IO CheckScriptResult checkScript con name checksum = - query con q (Only name) >>= \r -> case r of + query con q (Only name) >>= \case [] -> return ScriptNotExecuted Only actualChecksum:_ | checksum == actualChecksum -> diff --git a/src/Database/PostgreSQL/Simple/Util.hs b/src/Database/PostgreSQL/Simple/Util.hs --- a/src/Database/PostgreSQL/Simple/Util.hs +++ b/src/Database/PostgreSQL/Simple/Util.hs @@ -10,6 +10,7 @@ -- A collection of utilites for database migrations. {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Database.PostgreSQL.Simple.Util diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -10,6 +10,7 @@ -- A standalone program for the postgresql-simple-migration library. {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Main ( @@ -20,22 +21,22 @@ import Control.Applicative #endif import Control.Exception -import Control.Monad (void) import qualified Data.ByteString.Char8 as BS8 (pack) import Database.PostgreSQL.Simple (SqlError (..), connectPostgreSQL, withTransaction) import Database.PostgreSQL.Simple.Migration (MigrationCommand (..), MigrationContext (..), + MigrationResult (..), runMigration) import System.Environment (getArgs) -import System.Exit (exitFailure) +import System.Exit (exitFailure, exitSuccess) import qualified Data.Text as T import qualified Data.Text.Encoding as T main :: IO () -main = getArgs >>= \args -> case args of +main = getArgs >>= \case "-h":_ -> printUsage "-q":xs -> @@ -49,7 +50,6 @@ where ehandler e = maybe (throw e) (*> exitFailure) (pSqlError <$> fromException e) - -- <|> (pOtherError <$> fromException e) bsToString = T.unpack . T.decodeUtf8 pSqlError e = mapM_ putStrLn [ "SqlError:" @@ -68,7 +68,7 @@ run :: Maybe Command -> Bool-> IO () run Nothing _ = printUsage >> exitFailure run (Just cmd) verbose = - void $ case cmd of + handleResult =<< case cmd of Initialize url -> do con <- connectPostgreSQL (BS8.pack url) withTransaction con $ runMigration $ MigrationContext @@ -81,12 +81,15 @@ con <- connectPostgreSQL (BS8.pack url) withTransaction con $ runMigration $ MigrationContext (MigrationValidation (MigrationDirectory dir)) verbose con + where + handleResult MigrationSuccess = exitSuccess + handleResult (MigrationError _) = exitFailure parseCommand :: [String] -> Maybe Command -parseCommand ("init":url:_) = Just (Initialize url) -parseCommand ("migrate":url:dir:_) = Just (Migrate url dir) +parseCommand ("init":url:_) = Just (Initialize url) +parseCommand ("migrate":url:dir:_) = Just (Migrate url dir) parseCommand ("validate":url:dir:_) = Just (Validate url dir) -parseCommand _ = Nothing +parseCommand _ = Nothing printUsage :: IO () printUsage = do diff --git a/test/Database/PostgreSQL/Simple/MigrationTest.hs b/test/Database/PostgreSQL/Simple/MigrationTest.hs --- a/test/Database/PostgreSQL/Simple/MigrationTest.hs +++ b/test/Database/PostgreSQL/Simple/MigrationTest.hs @@ -9,8 +9,9 @@ -- -- A collection of postgresql-simple-migration specifications. +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module Database.PostgreSQL.Simple.MigrationTest where diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -9,8 +9,9 @@ -- -- The test entry-point for postgresql-simple-migration. +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module Main ( main