module Moo.CommandHandlers where
import Control.Applicative ((<$>))
import Moo.Core
import Moo.CommandUtils
import Control.Monad ( when, forM_ )
import Data.Maybe ( isJust )
import Control.Monad.Reader ( asks )
import System.Exit ( exitWith, ExitCode(..), exitSuccess )
import qualified Data.Time.Clock as Clock
import Control.Monad.Trans ( liftIO )
import Database.Schema.Migrations.Store hiding (getMigrations)
import Database.Schema.Migrations
import Database.Schema.Migrations.Migration
import Database.Schema.Migrations.Backend
newCommand :: CommandHandler
newCommand storeData = do
required <- asks _appRequiredArgs
store <- asks _appStore
linear <- asks _appLinearMigrations
timestamp <- asks _appTimestampFilenames
timeString <- (++"_") <$> liftIO getCurrentTimestamp
let [migrationId] = if timestamp
then fmap (timeString++) required
else required
noAsk <- _noAsk <$> asks _appOptions
liftIO $ do
fullPath <- fullMigrationName store migrationId
when (isJust $ storeLookup storeData migrationId) $
do
putStrLn $ "Migration " ++ (show fullPath) ++ " already exists"
exitWith (ExitFailure 1)
deps <- if linear then (return $ leafMigrations storeData) else
if noAsk then (return []) else
do
putStrLn $ "Selecting dependencies for new \
\migration: " ++ migrationId
interactiveAskDeps storeData
result <- if noAsk then (return True) else
(confirmCreation migrationId deps)
case result of
True -> do
now <- Clock.getCurrentTime
status <- createNewMigration store $ (newMigration migrationId) { mDeps = deps
, mTimestamp = Just now
}
case status of
Left e -> putStrLn e >> (exitWith (ExitFailure 1))
Right _ -> putStrLn $ "Migration created successfully: " ++
show fullPath
False -> do
putStrLn "Migration creation cancelled."
upgradeCommand :: CommandHandler
upgradeCommand storeData = do
isTesting <- _test <$> asks _appOptions
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
migrationNames <- missingMigrations backend storeData
when (null migrationNames) $ do
putStrLn "Database is up to date."
exitSuccess
forM_ migrationNames $ \migrationName -> do
m <- lookupMigration storeData migrationName
apply m storeData backend False
case isTesting of
True -> do
rollbackBackend backend
putStrLn "Upgrade test successful."
False -> do
commitBackend backend
putStrLn "Database successfully upgraded."
upgradeListCommand :: CommandHandler
upgradeListCommand storeData = do
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
migrationNames <- missingMigrations backend storeData
when (null migrationNames) $ do
putStrLn "Database is up to date."
exitSuccess
putStrLn "Migrations to install:"
forM_ migrationNames (putStrLn . (" " ++))
reinstallCommand :: CommandHandler
reinstallCommand storeData = do
isTesting <- _test <$> asks _appOptions
required <- asks _appRequiredArgs
let [migrationId] = required
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
m <- lookupMigration storeData migrationId
revert m storeData backend
apply m storeData backend True
case isTesting of
False -> do
commitBackend backend
putStrLn "Migration successfully reinstalled."
True -> do
rollbackBackend backend
putStrLn "Reinstall test successful."
listCommand :: CommandHandler
listCommand _ = do
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
ms <- getMigrations backend
forM_ ms $ \m ->
when (not $ m == rootMigrationName) $ putStrLn m
applyCommand :: CommandHandler
applyCommand storeData = do
isTesting <- _test <$> asks _appOptions
required <- asks _appRequiredArgs
let [migrationId] = required
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
m <- lookupMigration storeData migrationId
apply m storeData backend True
case isTesting of
False -> do
commitBackend backend
putStrLn "Successfully applied migrations."
True -> do
rollbackBackend backend
putStrLn "Migration installation test successful."
revertCommand :: CommandHandler
revertCommand storeData = do
isTesting <- _test <$> asks _appOptions
required <- asks _appRequiredArgs
let [migrationId] = required
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
m <- lookupMigration storeData migrationId
revert m storeData backend
case isTesting of
False -> do
commitBackend backend
putStrLn "Successfully reverted migrations."
True -> do
rollbackBackend backend
putStrLn "Migration uninstallation test successful."
testCommand :: CommandHandler
testCommand storeData = do
required <- asks _appRequiredArgs
let [migrationId] = required
withBackend $ \backend -> do
ensureBootstrappedBackend backend >> commitBackend backend
m <- lookupMigration storeData migrationId
migrationNames <- missingMigrations backend storeData
when (not $ migrationId `elem` migrationNames) $
do revert m storeData backend
return ()
applied <- apply m storeData backend True
forM_ (reverse applied) $ \migration -> do
revert migration storeData backend
rollbackBackend backend
putStrLn "Successfully tested migrations."