-- | -- Module : Main -- Copyright : (c) 2014 Andreas Meingast -- -- License : BSD-style -- Maintainer : ameingast@gmail.com -- Stability : experimental -- Portability : GHC -- -- A standalone program for the postgresql-simple-migration library. module Main ( main ) where import Control.Monad (void) import qualified Data.ByteString.Char8 as BS8 (pack) import Database.PostgreSQL.Simple (connectPostgreSQL, withTransaction) import Database.PostgreSQL.Simple.Migration (MigrationCommand (..), MigrationContext (..), runMigration) import System.Environment (getArgs) import System.Exit (exitFailure) main :: IO () main = getArgs >>= \args -> case args of "-h":_ -> printUsage "-q":xs -> run (parseCommand xs) False xs -> run (parseCommand xs) True run :: Maybe Command -> Bool-> IO () run Nothing _ = printUsage >> exitFailure run (Just cmd) verbose = void $ case cmd of Initialize url -> do con <- connectPostgreSQL (BS8.pack url) withTransaction con $ runMigration $ MigrationContext MigrationInitialization verbose con Migrate url dir -> do con <- connectPostgreSQL (BS8.pack url) withTransaction con $ runMigration $ MigrationContext (MigrationDirectory dir) verbose con Validate url dir -> do con <- connectPostgreSQL (BS8.pack url) withTransaction con $ runMigration $ MigrationContext (MigrationValidation (MigrationDirectory dir)) verbose con parseCommand :: [String] -> Maybe Command parseCommand ("init":url:_) = Just (Initialize url) parseCommand ("migrate":url:dir:_) = Just (Migrate url dir) parseCommand ("validate":url:dir:_) = Just (Validate url dir) parseCommand _ = Nothing printUsage :: IO () printUsage = do putStrLn "migrate [options] " putStrLn " Options:" putStrLn " -h Print help text" putStrLn " -q Enable quiet mode" putStrLn " Commands:" putStrLn " init " putStrLn " Initialize the database. Required to be run" putStrLn " at least once." putStrLn " migrate " putStrLn " Execute all SQL scripts in the provided" putStrLn " directory in alphabetical order." putStrLn " Scripts that have already been executed are" putStrLn " ignored. If a script was changed since the" putStrLn " time of its last execution, an error is" putStrLn " raised." putStrLn " validate " putStrLn " Validate all SQL scripts in the provided" putStrLn " directory." putStrLn " The parameter is based on libpq connection string" putStrLn " syntax. Detailled information is available here:" putStrLn " " data Command = Initialize String | Migrate String FilePath | Validate String FilePath deriving (Show, Eq, Read, Ord)