diff --git a/MOO.TXT b/MOO.TXT --- a/MOO.TXT +++ b/MOO.TXT @@ -1,15 +1,21 @@ -moo: the dbmigrations management tool -------------------------------------- +moo: the dbmigrations management tools +------------------------------------------ -The dbmigrations package exposes a library and a tool. The tool, called -"moo", is responsible for creating, installing, and reverting migrations -in your database backend. +The database type specific package that work as a companion to this +library contain tools called "moo-postgresql", "moo-mysql", "moo-sqlite", +etc. They are responsible for creating, installing, and reverting migrations +in your database backend. Since all of these command line tools offer the +exact same interface, they are described here in a single document. +The executables mentioned above are simply called "moo" for the rest of +this document. That is, given an example that reads as "moo command" you +actually have to execute "moo-postgresql command" or "moo-mysql command" +and so on. At present, MySQL, PostgreSQL and Sqlite3 are the only supported database backends. -The moo tool works by creating migration files in a specific location, +The moo tools work by creating migration files in a specific location, called a migration store, on your filesystem. This directory is where all possible migrations for your project will be kept. Moo allows you to create migrations that depend on each other. When you use moo to upgrade @@ -25,42 +31,20 @@ migrations is tracked by way of a migration table that is installed into your database. -WARNING TO MYSQL USERS ----------------------- -If you are using this library with MySQL, beware of the following -caveat! +Using dbmigrations with MySQL +----------------------------- -Unlike PostgreSQL and SQLite, MySQL does not support transactional -Data Definition Language (DDL) statements such as CREATE TABLE. Since -dbmigrations is designed around the assumption that it's useful and -important to make migrations atomic, and since most migrations will have -at least some DDL in them, this means that dbmigrations cannot make -atomicity guarantees about your migrations if you are using MySQL as -your backend. The MySQL docs have this to say: +While dbmigrations supports MySQL in general, the moo executable in this +package does not work with a MySQL backend directly. MySQL support has +been factored out into a separate package, called dbmigrations-mysql. +If you want to apply migrations to a MySQL backend, please install and +use dbmigrations-mysql instead of this package. The reason is that the +MySQL support depends on MySQL Haskell libraries which in turn have +build dependencies that make it necessary for MySQL itself to be +installed during build time. -http://dev.mysql.com/doc/refman/5.7/en/cannot-roll-back.html -This means that features like moo's "--test" flag will not do what you -expect, that mistakes in migrations will be tough to fix in development, -and that a problem in a migration in a production deployment COULD -HOSE YOUR DATABASE and BREAK RUNNING APPLICATIONS. Note that MySQL's -DDL statements cause an implicit commit, so any errors after each DDL -statement will have to be corrected by hand! - -It is the author's opinion that this makes MySQL unfit for production -use and that you should strongly consider using some other backend such -as PostgreSQL which has much more robust support for transactional DDL. - -You might be wondering why support for MySQL is included if it can be -so dangerous to use. Some users have requested and contributed support -for it, and of course we can't always choose to use a different backend -for preexisting systems. In those cases at least dbmigrations doesn't -make your problem any worse than it already is, provided you heed this -disclaimer. :) - -You have been warned! - Getting started --------------- @@ -69,16 +53,12 @@ 2. Set an environment variable DBM_MIGRATION_STORE to the path to the directory you created in step 1. - 3. Set an environment variable DBM_DATABASE_TYPE to a supported - backend. Valid values are "mysql", "postgresql" and "sqlite3". - - 4. Set an environment variable DBM_DATABASE to a database connection - string that is appropriate for the value of DBM_DATABASE_TYPE you - chose. The contents of this depend on the value of - DBM_DATABASE_TYPE, see the "Environment" documentation section for - more information. + 3. Set an environment variable DBM_DATABASE to a database connection + string that is appropriate for the database type you + chose. The contents of this depend on the database type, see the + "Environment" documentation section for more information. - 5. Run "moo upgrade". This command will not actually install any + 4. Run "moo upgrade". This command will not actually install any migrations, since you have not created any, but it will attempt to connect to your database and install a migration-tracking table. @@ -86,17 +66,17 @@ Database is up to date. - 6. Create a migration with "moo new". Here is an example output: + 5. Create a migration with "moo new". Here is an example output: $ moo new hello-world Selecting dependencies for new migration: hello-world - + Confirm: create migration 'hello-world' (No dependencies) Are you sure? (yn): y Migration created successfully: ".../hello-world.txt" - 7. Edit the migration you created. In this case, moo created a file + 6. Edit the migration you created. In this case, moo created a file $DBM_MIGRATION_STORE/hello_world.txt that looks like this: Description: (Description here.) @@ -104,7 +84,7 @@ Depends: Apply: | (Apply SQL here.) - + Revert: | (Revert SQL here.) @@ -113,11 +93,11 @@ Apply: | CREATE TABLE foo (a int); - + Revert: | DROP TABLE foo; - 8. Test the new migration with "moo test". This will install the + 7. Test the new migration with "moo test". This will install the migration in a transaction and roll it back. Here is example output: $ moo test hello-world @@ -125,7 +105,7 @@ Reverting: hello-world... done. Successfully tested migrations. - 9. Install the migration. This can be done in one of two ways: with + 8. Install the migration. This can be done in one of two ways: with "moo upgrade" or with "moo apply". Here are examples: $ moo apply hello-world @@ -136,7 +116,7 @@ Applying: hello-world... done. Database successfully upgraded. - 10. List installed migrations with "moo list". + 9. List installed migrations with "moo list". $ moo list hello-world @@ -162,7 +142,6 @@ configuration file format uses the same environment variable names for its fields. An example configuration is as follows: - DBM_DATABASE_TYPE = "sqlite3" DBM_DATABASE = "/path/to/database.db" DBM_MIGRATION_STORE = "/path/to/migration/store" DBM_LINEAR_MIGRATIONS = on/off (or true/false; defaults to off) @@ -231,31 +210,25 @@ Moo depends on these environment variables / configuration file settings: - DBM_DATABASE_TYPE - - The type of database you'll be managing. Supported values - at present are "mysql", "postgresql" and "sqlite3". This will - determine the format of DBM_DATABASE. - DBM_DATABASE The database connection string for the database you'll be managing. The connection strings for each supported database type are as follows: - DBM_DATABASE_TYPE=postgresql: + PostgreSQL: The format of this value is a PostgreSQL database connection string, i.e., that described at: http://www.postgresql.org/docs/8.1/static/libpq.html#LIBPQ-CONNECT - DBM_DATABASE_TYPE=sqlite3: + SQlite3: The format of this value is a filesystem path to the Sqlite3 database to be used. - DBM_DATABASE_TYPE=mysql: + MySQL: For MySQL, DBM_DATABASE should be a value of key value pairs, where each pair is formed by `key=value`, and each pair separated diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,37 +2,38 @@ dbmigrations ------------ -This package contains a library and program for the creation, -management, and installation of schema updates (called "migrations") -for a relational database. In particular, this package lets the -migration author express explicit dependencies between migrations and -the management tool automatically installs or reverts migrations -accordingly, using transactions for safety. +This package contains a library for the creation, management, and +installation of schema updates (called "migrations") for a relational +database. In particular, this package lets the migration author express +explicit dependencies between migrations. This library is accompanied +by a number database-specific packages that contain the management +tools to automatically install or revert migrations accordingly. This package operates on two logical entities: - - The "backend", which is the relational database whose schema you - want to manage. + - The "backend": the relational database whose schema you want to + manage. - - The "migration store" (or simply "store"), which is the collection - of schema changes you want to apply to the database. These - migrations are expressed using plain text files collected together - in a single directory, although the library is general enough to - permit easy implementation of other storage backends for - migrations. + - The "migration store": the collection of schema changes you want to + apply to the database. These migrations are expressed using plain + text files collected together in a single directory, although the + library is general enough to permit easy implementation of other + storage representations for migrations. -Getting started with dbmigrations ---------------------------------- +Getting started +--------------- -This package includes one program, "moo". See MOO.TXT for details on how -to use this tool to manage your database migrations. +To get started, install the right database-specific dbmigrations package +for your database. Current options are: -Installation ------------- + * `dbmigrations-postgresql` + * `dbmigrations-mysql` + * `dbmigrations-sqlite` -If you've obtained this package in source form and would like to -install it, you'll need the "cabal" program. To install this package -from the source directory, run `cabal install`. +Each package provides a variant of the "moo" management program +("moo-postgresql", "moo-mysql", and "moo-sqlite" respectively) to be +used to manage your database schema. See MOO.TXT for details on how to +use these tools to manage your database migrations. Submitting patches ------------------ diff --git a/dbmigrations.cabal b/dbmigrations.cabal --- a/dbmigrations.cabal +++ b/dbmigrations.cabal @@ -1,23 +1,27 @@ Name: dbmigrations -Version: 1.1.1 +Version: 2.0.0 Synopsis: An implementation of relational database "migrations" Description: A library and program for the creation, management, and installation of schema updates - (called /migrations/) for a relational database. - In particular, this package lets the migration - author express explicit dependencies between - migrations and the management tool automatically - installs or reverts migrations accordingly, using - transactions for safety. + (called /migrations/) for a relational database. In + particular, this package lets the migration author + express explicit dependencies between migrations + and the management tool automatically installs or + reverts migrations accordingly, using transactions + for safety. - This package is written to support any - HDBC-supported database. This package supports - SQLite, PostgreSQL, and MySQL. Please see MOO.TXT - for warnings about MySQL! + This package is written to support a number of + different databases. For packages that support + specific databases using this library, see packages + named "dbmigrations-BACKEND". Each package + provides an executable "moo-BACKEND" for managing + migrations. Usage information for the "moo-" + executables can be found in "MOO.TXT" in this + package. - To get started, see the included 'README.md' and - 'MOO.TXT' files and the usage output for the - 'moo' command. + This package also includes a conformance test suite + to ensure that backend implementations respect the + library's required semantics. Category: Database Author: Jonathan Daugherty @@ -33,6 +37,11 @@ test/example_store/root test/example_store/update1 test/example_store/update2 + test/config_loading/cfg1.cfg + test/config_loading/cfg_ts.cfg + test/config_loading/invalid.cfg + test/config_loading/missing.cfg + test/config_loading/moo.cfg test/migration_parsing/invalid_field_name.txt test/migration_parsing/invalid_missing_required_fields.txt test/migration_parsing/invalid_syntax.txt @@ -41,6 +50,7 @@ test/migration_parsing/valid_no_depends.txt test/migration_parsing/valid_no_desc.txt test/migration_parsing/valid_no_revert.txt + test/migration_parsing/valid_no_timestamp.txt test/migration_parsing/valid_with_colon.txt test/migration_parsing/valid_with_comments.txt test/migration_parsing/valid_with_comments2.txt @@ -73,27 +83,24 @@ bytestring >= 0.9, text >= 0.11, configurator >= 0.2, - HDBC-postgresql, - HDBC-sqlite3, - mysql >= 0.1.1.8, - mysql-simple >= 0.2.2.5, - split >= 0.2.2 + split >= 0.2.2, + HUnit >= 1.2 Hs-Source-Dirs: src Exposed-Modules: Database.Schema.Migrations - Database.Schema.Migrations.Dependencies - Database.Schema.Migrations.Migration - Database.Schema.Migrations.Filesystem Database.Schema.Migrations.Backend Database.Schema.Migrations.Backend.HDBC - Database.Schema.Migrations.Backend.MySQL + Database.Schema.Migrations.Dependencies + Database.Schema.Migrations.Filesystem + Database.Schema.Migrations.Migration Database.Schema.Migrations.Store - Moo.Main + Database.Schema.Migrations.Test.BackendTest Moo.CommandHandlers Moo.CommandInterface Moo.CommandUtils Moo.Core + Moo.Main Other-Modules: Database.Schema.Migrations.CycleDetection @@ -104,6 +111,7 @@ type: exitcode-stdio-1.0 Build-Depends: base >= 4 && < 5, + dbmigrations, time >= 1.4, containers >= 0.2, mtl >= 2.1, @@ -115,18 +123,13 @@ bytestring >= 0.9, MissingH, HDBC >= 2.2.1, - HDBC-postgresql, - HDBC-sqlite3, HUnit >= 1.2, process >= 1.1, configurator >= 0.2, text >= 0.11, - mysql-simple >= 0.2.2.5, - mysql >= 0.1.1.8, split >= 0.2.2 other-modules: - BackendTest Common CommonTH CycleDetectionTest diff --git a/programs/Moo.hs b/programs/Moo.hs --- a/programs/Moo.hs +++ b/programs/Moo.hs @@ -3,18 +3,15 @@ ) where -import Prelude hiding (lookup) -import System.Environment (getArgs) -import System.Exit - -import Moo.Core -import Moo.Main +import Prelude main :: IO () main = do - args <- getArgs - (_, opts, _) <- procArgs args - conf <- loadConfiguration $ _configFilePath opts - case conf of - Left e -> putStrLn e >> exitFailure - Right c -> mainWithConf args c + error $ + "This package (dbmigrations) does no longer contain the executable to \ + \create, apply or revert database migrations. Please install the specific \ + \wrapper package for your database: dbmigrations-postgresql, \ + \dbmigrations-mysql, or dbmigrations-sqlite. These packages contain \ + \database-specific executables that replace the former moo executable from the \ + \dbmigrations package." + diff --git a/src/Database/Schema/Migrations/Backend.hs b/src/Database/Schema/Migrations/Backend.hs --- a/src/Database/Schema/Migrations/Backend.hs +++ b/src/Database/Schema/Migrations/Backend.hs @@ -69,3 +69,6 @@ , disconnectBackend :: IO () -- ^ Disconnect from the backend. } + +instance Show Backend where + show _ = show "dbmigrations backend" diff --git a/src/Database/Schema/Migrations/Backend/MySQL.hs b/src/Database/Schema/Migrations/Backend/MySQL.hs deleted file mode 100644 --- a/src/Database/Schema/Migrations/Backend/MySQL.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Database.Schema.Migrations.Backend.MySQL (mysqlBackend) where - -import Control.Monad (when) -import Database.MySQL.Simple -import Database.Schema.Migrations.Backend - (Backend(..), rootMigrationName) -import Database.Schema.Migrations.Migration - (Migration(..), newMigration) -import Data.Time.Clock (getCurrentTime) -import Data.String (fromString) -import Data.Maybe (listToMaybe) -import qualified Database.MySQL.Base as Base - -mysqlBackend :: Connection -> Backend -mysqlBackend conn = - Backend {isBootstrapped = - fmap ((Just migrationTableName ==) . listToMaybe . fmap fromOnly) - (query conn - (fromString "SELECT table_name FROM information_schema.tables WHERE table_name = ? AND table_schema = database()") - (Only migrationTableName) :: IO [Only String]) - ,getBootstrapMigration = - do ts <- getCurrentTime - return ((newMigration rootMigrationName) {mApply = createSql - ,mRevert = - Just revertSql - ,mDesc = - Just "Migration table installation" - ,mTimestamp = Just ts}) - ,applyMigration = - \m -> - do execute_ conn (fromString (mApply m)) - discardResults conn - execute conn - (fromString - ("INSERT INTO " ++ - migrationTableName ++ - " (migration_id) VALUES (?)")) - (Only (mId m)) - return () - ,revertMigration = - \m -> - do case mRevert m of - Nothing -> return () - Just sql -> - do execute_ conn (fromString sql) - return () - discardResults conn - -- Remove migration from installed_migrations in either case. - execute - conn - (fromString - ("DELETE FROM " ++ - migrationTableName ++ " WHERE migration_id = ?")) - (Only (mId m)) - return () - ,getMigrations = - do results <- - query_ conn - (fromString - ("SELECT migration_id FROM " ++ migrationTableName)) - return (map fromOnly results) - ,commitBackend = commit conn - ,rollbackBackend = rollback conn - ,disconnectBackend = close conn} - -discardResults :: Connection -> IO () -discardResults conn = - do more <- Base.nextResult conn - when more (discardResults conn) - -migrationTableName :: String -migrationTableName = "installed_migrations" - -createSql :: String -createSql = "CREATE TABLE " ++ migrationTableName ++ " (migration_id TEXT)" - -revertSql :: String -revertSql = "DROP TABLE " ++ migrationTableName diff --git a/src/Database/Schema/Migrations/Test/BackendTest.hs b/src/Database/Schema/Migrations/Test/BackendTest.hs new file mode 100644 --- /dev/null +++ b/src/Database/Schema/Migrations/Test/BackendTest.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | A test that is not executed as part of this package's test suite but rather +-- acts as a conformance test suit for database specific backend +-- implementations. All backend specific executable packages are expected to +-- have a test suite that runs this test. +module Database.Schema.Migrations.Test.BackendTest + ( BackendConnection (..) + , tests + ) where + +import Control.Monad ( forM_ ) +import Test.HUnit + +import Database.Schema.Migrations.Migration ( Migration(..), newMigration ) +import Database.Schema.Migrations.Backend ( Backend(..) ) + +-- | A typeclass for database connections that needs to implemented for each +-- specific database type to use this test. +class BackendConnection c where + + -- | Whether this backend supports transactional DDL; if it doesn't, + -- we'll skip any tests that rely on that behavior. + supportsTransactionalDDL :: c -> Bool + + -- | Commits the current transaction. + commit :: c -> IO () + + -- | Executes an IO action inside a transaction. + withTransaction :: c -> (c -> IO a) -> IO a + + -- | Retrieves a list of all tables in the current database/scheme. + getTables :: c -> IO [String] + + catchAll :: c -> (IO a -> IO a -> IO a) + + -- | Returns a backend instance. + makeBackend :: c -> Backend + +testSuite :: BackendConnection bc => Bool -> [bc -> IO ()] +testSuite transactDDL = + [ isBootstrappedFalseTest + , bootstrapTest + , isBootstrappedTrueTest + , if transactDDL then applyMigrationFailure else (const $ return ()) + , applyMigrationSuccess + , revertMigrationFailure + , revertMigrationNothing + , revertMigrationJust + ] + +tests :: BackendConnection bc => bc -> IO () +tests conn = do + let acts = testSuite $ supportsTransactionalDDL conn + forM_ acts $ \act -> do + commit conn + act conn + +bootstrapTest :: BackendConnection bc => bc -> IO () +bootstrapTest conn = do + let backend = makeBackend conn + bs <- getBootstrapMigration backend + applyMigration backend bs + assertEqual "installed_migrations table exists" ["installed_migrations"] =<< getTables conn + assertEqual "successfully bootstrapped" [mId bs] =<< getMigrations backend + +isBootstrappedTrueTest :: BackendConnection bc => bc -> IO () +isBootstrappedTrueTest conn = do + result <- isBootstrapped $ makeBackend conn + assertBool "Bootstrapped check" result + +isBootstrappedFalseTest :: BackendConnection bc => bc -> IO () +isBootstrappedFalseTest conn = do + result <- isBootstrapped $ makeBackend conn + assertBool "Bootstrapped check" $ not result + +ignoreSqlExceptions :: BackendConnection bc => bc -> IO a -> IO (Maybe a) +ignoreSqlExceptions conn act = + (catchAll conn) + (act >>= return . Just) + (return Nothing) + +applyMigrationSuccess :: BackendConnection bc => bc -> IO () +applyMigrationSuccess conn = do + let backend = makeBackend conn + + let m1 = (newMigration "validMigration") { mApply = "CREATE TABLE valid1 (a int)" } + + -- Apply the migrations, ignore exceptions + withTransaction conn $ \conn' -> applyMigration (makeBackend conn') m1 + + -- Check that none of the migrations were installed + assertEqual "Installed migrations" ["root", "validMigration"] =<< getMigrations backend + assertEqual "Installed tables" ["installed_migrations", "valid1"] =<< getTables conn + +-- |Does a failure to apply a migration imply a transaction rollback? +applyMigrationFailure :: BackendConnection bc => bc -> IO () +applyMigrationFailure conn = do + let backend = makeBackend conn + + let m1 = (newMigration "second") { mApply = "CREATE TABLE validButTemporary (a int)" } + m2 = (newMigration "third") { mApply = "INVALID SQL" } + + -- Apply the migrations, ignore exceptions + ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do + let backend' = makeBackend conn' + applyMigration backend' m1 + applyMigration backend' m2 + + -- Check that none of the migrations were installed + assertEqual "Installed migrations" ["root"] =<< getMigrations backend + assertEqual "Installed tables" ["installed_migrations"] =<< getTables conn + +revertMigrationFailure :: BackendConnection bc => bc -> IO () +revertMigrationFailure conn = do + let backend = makeBackend conn + + let m1 = (newMigration "second") { mApply = "CREATE TABLE validRMF (a int)" + , mRevert = Just "DROP TABLE validRMF"} + m2 = (newMigration "third") { mApply = "alter table validRMF add column b int" + , mRevert = Just "INVALID REVERT SQL"} + + applyMigration backend m1 + applyMigration backend m2 + + installedBeforeRevert <- getMigrations backend + + commitBackend backend + + -- Revert the migrations, ignore exceptions; the revert will fail, + -- but withTransaction will roll back. + ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do + let backend' = makeBackend conn' + revertMigration backend' m2 + revertMigration backend' m1 + + -- Check that none of the migrations were reverted + assertEqual "successfully roll back failed revert" installedBeforeRevert + =<< getMigrations backend + +revertMigrationNothing :: BackendConnection bc => bc -> IO () +revertMigrationNothing conn = do + let backend = makeBackend conn + + let m1 = (newMigration "second") { mApply = "create table revert_nothing (a int)" + , mRevert = Nothing } + + applyMigration backend m1 + + installedAfterApply <- getMigrations backend + assertBool "Check that the migration was applied" $ "second" `elem` installedAfterApply + + -- Revert the migration, which should do nothing EXCEPT remove it + -- from the installed list + revertMigration backend m1 + + installed <- getMigrations backend + assertBool "Check that the migration was reverted" $ not $ "second" `elem` installed + +revertMigrationJust :: BackendConnection bc => bc -> IO () +revertMigrationJust conn = do + let name = "revertable" + backend = makeBackend conn + + let m1 = (newMigration name) { mApply = "CREATE TABLE the_test_table (a int)" + , mRevert = Just "DROP TABLE the_test_table" } + + applyMigration backend m1 + + installedAfterApply <- getMigrations backend + assertBool "Check that the migration was applied" $ name `elem` installedAfterApply + + -- Revert the migration, which should do nothing EXCEPT remove it + -- from the installed list + revertMigration backend m1 + + installed <- getMigrations backend + assertBool "Check that the migration was reverted" $ not $ name `elem` installed diff --git a/src/Moo/CommandHandlers.hs b/src/Moo/CommandHandlers.hs --- a/src/Moo/CommandHandlers.hs +++ b/src/Moo/CommandHandlers.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} module Moo.CommandHandlers where -import Control.Applicative ((<$>)) import Moo.Core import Moo.CommandUtils import Control.Monad ( when, forM_ ) diff --git a/src/Moo/CommandUtils.hs b/src/Moo/CommandUtils.hs --- a/src/Moo/CommandUtils.hs +++ b/src/Moo/CommandUtils.hs @@ -6,12 +6,11 @@ , lookupMigration , revert , withBackend - , makeBackend , getCurrentTimestamp ) where import Control.Applicative -import Control.Exception ( bracket ) +import Control.Exception ( finally ) import Control.Monad ( when, forM_, unless ) import Control.Monad.Reader ( asks ) import Control.Monad.Trans ( liftIO ) @@ -88,26 +87,13 @@ exitWith (ExitFailure 1) Just m' -> return m' --- Given a database type string and a database connection string, --- return a database connection or raise an error if the database --- connection cannot be established, or if the database type is not --- supported. -makeBackend :: String -> DbConnDescriptor -> IO Backend -makeBackend dbType (DbConnDescriptor connStr) = - case lookup dbType databaseTypes of - Nothing -> error $ "Unsupported database type " ++ show dbType ++ - " (supported types: " ++ - intercalate "," (map fst databaseTypes) ++ ")" - Just mkBackend -> mkBackend connStr - -- Given an action that needs a database connection, connect to the --- database using the application configuration and invoke the action --- with the connection. Return its result. +-- database using the backend and invoke the action +-- with the connection. Return its result. withBackend :: (Backend -> IO a) -> AppT a withBackend act = do - dbPath <- asks _appDatabaseConnStr - dbType <- asks _appDatabaseType - liftIO $ bracket (makeBackend dbType dbPath) disconnectBackend act + backend <- asks _appBackend + liftIO $ (act backend) `finally` (disconnectBackend backend) -- Given a migration name and selected dependencies, get the user's -- confirmation that a migration should be created. diff --git a/src/Moo/Core.hs b/src/Moo/Core.hs --- a/src/Moo/Core.hs +++ b/src/Moo/Core.hs @@ -6,34 +6,24 @@ , Command (..) , AppState (..) , Configuration (..) - , DbConnDescriptor (..) - , databaseTypes + , makeParameters + , ExecutableParameters (..) , envDatabaseName - , envDatabaseType , envLinearMigrations , envStoreName , loadConfiguration) where -import Data.List.Split (wordsBy) -import Data.Char (isSpace) import Control.Applicative import Control.Monad.Reader (ReaderT) import qualified Data.Configurator as C import Data.Configurator.Types (Config, Configured) import qualified Data.Text as T import Data.Char (toLower) -import Database.HDBC.PostgreSQL (connectPostgreSQL) -import Database.HDBC.Sqlite3 (connectSqlite3) import System.Environment (getEnvironment) import Data.Maybe (fromMaybe) -import qualified Database.MySQL.Simple as MySQL -import qualified Database.MySQL.Base as MySQLB -import Database.Schema.Migrations () import Database.Schema.Migrations.Store (MigrationStore, StoreData) import Database.Schema.Migrations.Backend -import Database.Schema.Migrations.Backend.HDBC -import Database.Schema.Migrations.Backend.MySQL -- |The monad in which the application runs. type AppT a = ReaderT AppState IO a @@ -42,58 +32,64 @@ type CommandHandler = StoreData -> AppT () -- |Application state which can be accessed by any command handler. -data AppState = AppState { _appOptions :: CommandOptions - , _appCommand :: Command - , _appRequiredArgs :: [String] - , _appOptionalArgs :: [String] - , _appStore :: MigrationStore - , _appDatabaseConnStr :: DbConnDescriptor - , _appDatabaseType :: String - , _appStoreData :: StoreData - , _appLinearMigrations :: Bool +data AppState = AppState { _appOptions :: CommandOptions + , _appCommand :: Command + , _appRequiredArgs :: [String] + , _appOptionalArgs :: [String] + , _appBackend :: Backend + , _appStore :: MigrationStore + , _appStoreData :: StoreData + , _appLinearMigrations :: Bool , _appTimestampFilenames :: Bool } type ShellEnvironment = [(String, String)] +-- |Intermediate type used during config loading. +data LoadConfig = LoadConfig + { _lcConnectionString :: Maybe String + , _lcMigrationStorePath :: Maybe FilePath + , _lcLinearMigrations :: Maybe Bool + , _lcTimestampFilenames :: Maybe Bool + } deriving Show + +-- |Loading the configuration from a file or having it specified via environment +-- |variables results in a value of type Configuration. data Configuration = Configuration { _connectionString :: String - , _databaseType :: String , _migrationStorePath :: FilePath , _linearMigrations :: Bool , _timestampFilenames :: Bool } deriving Show --- |Intermediate type used during config loading. -data LoadConfig = LoadConfig - { _lcConnectionString :: Maybe String - , _lcDatabaseType :: Maybe String - , _lcMigrationStorePath :: Maybe FilePath - , _lcLinearMigrations :: Maybe Bool - , _lcTimestampFilenames :: Maybe Bool +-- |A value of type ExecutableParameters is what a moo executable (moo-postgresql, +-- |moo-mysql, etc.) pass to the core package when they want to execute a +-- |command. +data ExecutableParameters = ExecutableParameters + { _parametersBackend :: Backend + , _parametersMigrationStorePath :: FilePath + , _parametersLinearMigrations :: Bool + , _parametersTimestampFilenames :: Bool } deriving Show defConfigFile :: String defConfigFile = "moo.cfg" newLoadConfig :: LoadConfig -newLoadConfig = LoadConfig Nothing Nothing Nothing Nothing Nothing +newLoadConfig = LoadConfig Nothing Nothing Nothing Nothing validateLoadConfig :: LoadConfig -> Either String Configuration -validateLoadConfig (LoadConfig Nothing _ _ _ _) = +validateLoadConfig (LoadConfig Nothing _ _ _) = Left "Invalid configuration: connection string not specified" -validateLoadConfig (LoadConfig _ Nothing _ _ _) = - Left "Invalid configuration: database type not specified" -validateLoadConfig (LoadConfig _ _ Nothing _ _) = +validateLoadConfig (LoadConfig _ Nothing _ _) = Left "Invalid configuration: migration store path not specified" -validateLoadConfig (LoadConfig (Just cs) (Just dt) (Just msp) lm ts) = - Right $ Configuration cs dt msp (fromMaybe False lm) (fromMaybe False ts) +validateLoadConfig (LoadConfig (Just cs) (Just msp) lm ts) = + Right $ Configuration cs msp (fromMaybe False lm) (fromMaybe False ts) -- |Setters for fields of 'LoadConfig'. -lcConnectionString, lcDatabaseType, lcMigrationStorePath +lcConnectionString, lcMigrationStorePath :: LoadConfig -> Maybe String -> LoadConfig lcConnectionString c v = c { _lcConnectionString = v } -lcDatabaseType c v = c { _lcDatabaseType = v } lcMigrationStorePath c v = c { _lcMigrationStorePath = v } lcLinearMigrations :: LoadConfig -> Maybe Bool -> LoadConfig @@ -121,15 +117,14 @@ applyEnvironment :: ShellEnvironment -> LoadConfig -> IO LoadConfig applyEnvironment env lc = return lc & lcConnectionString .= f envDatabaseName - & lcDatabaseType .= f envDatabaseType & lcMigrationStorePath .= f envStoreName & lcLinearMigrations .= readFlag <$> f envLinearMigrations + & lcTimestampFilenames .= readFlag <$> f envTimestampFilenames where f n = return $ lookup n env applyConfigFile :: Config -> LoadConfig -> IO LoadConfig applyConfigFile cfg lc = return lc & lcConnectionString .= f envDatabaseName - & lcDatabaseType .= f envDatabaseType & lcMigrationStorePath .= f envStoreName & lcLinearMigrations .= f envLinearMigrations & lcTimestampFilenames .= f envTimestampFilenames @@ -148,6 +143,15 @@ return $ validateLoadConfig cfg +makeParameters :: Configuration -> Backend -> ExecutableParameters +makeParameters conf backend = + ExecutableParameters + { _parametersBackend = backend + , _parametersMigrationStorePath = _migrationStorePath conf + , _parametersLinearMigrations = _linearMigrations conf + , _parametersTimestampFilenames = _timestampFilenames conf + } + -- |Converts @Just "on"@ and @Just "true"@ (case insensitive) to @True@, -- anything else to @False@. readFlag :: Maybe String -> Maybe Bool @@ -177,44 +181,6 @@ , _cHandler :: CommandHandler } -newtype DbConnDescriptor = DbConnDescriptor String - --- |The values of DBM_DATABASE_TYPE and their corresponding connection --- factory functions. -databaseTypes :: [(String, String -> IO Backend)] -databaseTypes = [ ("postgresql", fmap hdbcBackend . connectPostgreSQL) - , ("sqlite3", fmap hdbcBackend . connectSqlite3) - , ("mysql", fmap mysqlBackend . connectMySQL) - ] - --- A slightly hacky connection string parser for MySQL, because mysql-simple --- doesn't come with one. -connectMySQL :: String -> IO MySQL.Connection -connectMySQL connectionString = - let kvs = - [(map toLower (trimlr k),trimlr v) | kvPair <- - wordsBy (== ';') connectionString :: [String] - , let (k,v) = case wordsBy (== '=') kvPair of - (k':v':_) -> (k',v') - [k'] -> (k',"") - [] -> error "impossible"] - trimlr = takeWhile (not . isSpace) . dropWhile isSpace - connInfo = - MySQL.ConnectInfo - <$> lookup "host" kvs - <*> pure (read (fromMaybe "3306" (lookup "port" kvs))) - <*> lookup "user" kvs - <*> pure (fromMaybe "" (lookup "password" kvs)) - <*> lookup "database" kvs - <*> pure [MySQLB.MultiStatements] - <*> pure "" - <*> pure Nothing - in MySQL.connect (fromMaybe (error "Invalid connection string. Expected form: host=hostname; user=username; port=portNumber; database=dbname; password=pwd.") - connInfo) - -envDatabaseType :: String -envDatabaseType = "DBM_DATABASE_TYPE" - envDatabaseName :: String envDatabaseName = "DBM_DATABASE" @@ -226,3 +192,4 @@ envTimestampFilenames :: String envTimestampFilenames = "DBM_TIMESTAMP_FILENAMES" + diff --git a/src/Moo/Main.hs b/src/Moo/Main.hs --- a/src/Moo/Main.hs +++ b/src/Moo/Main.hs @@ -1,5 +1,6 @@ module Moo.Main - ( mainWithConf + ( mainWithParameters + , ExecutableParameters (..) , Configuration (..) , Args , usage @@ -9,7 +10,6 @@ where import Control.Monad.Reader (forM_, runReaderT, when) -import Data.List (intercalate) import Database.HDBC (SqlError, catchSql, seErrorMsg) import Prelude hiding (lookup) import System.Environment (getProgName) @@ -29,8 +29,6 @@ putStrLn $ "Usage: " ++ progName ++ " [args]" putStrLn "Environment:" putStrLn $ " " ++ envDatabaseName ++ ": database connection string" - putStrLn $ " " ++ envDatabaseType ++ ": database type, one of " ++ - intercalate "," (map fst databaseTypes) putStrLn $ " " ++ envStoreName ++ ": path to migration store" putStrLn $ " " ++ envLinearMigrations ++ ": whether to use linear migrations (defaults to False)" putStrLn "Commands:" @@ -60,15 +58,13 @@ return (command, opts, required) -mainWithConf :: Args -> Configuration -> IO () -mainWithConf args conf = do +mainWithParameters :: Args -> ExecutableParameters -> IO () +mainWithParameters args parameters = do (command, opts, required) <- procArgs args - let dbConnStr = _connectionString conf - dbType = _databaseType conf - storePathStr = _migrationStorePath conf + let storePathStr = _parametersMigrationStorePath parameters store = filesystemStore $ FSStore { storePath = storePathStr } - linear = _linearMigrations conf + linear = _parametersLinearMigrations parameters if length required < length ( _cRequired command) then usageSpecific command else @@ -83,12 +79,12 @@ , _appCommand = command , _appRequiredArgs = required , _appOptionalArgs = ["" :: String] - , _appDatabaseConnStr = DbConnDescriptor dbConnStr - , _appDatabaseType = dbType + , _appBackend = _parametersBackend parameters , _appStore = store , _appStoreData = storeData , _appLinearMigrations = linear - , _appTimestampFilenames = _timestampFilenames conf + , _appTimestampFilenames = + _parametersTimestampFilenames parameters } runReaderT (_cHandler command storeData) st `catchSql` reportSqlError diff --git a/test/BackendTest.hs b/test/BackendTest.hs deleted file mode 100644 --- a/test/BackendTest.hs +++ /dev/null @@ -1,187 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module BackendTest where - -import Test.HUnit -import Control.Exception (Handler(..), catches) -import Control.Monad ( forM_ ) - -import Database.Schema.Migrations.Backend.HDBC (hdbcBackend) -import Database.Schema.Migrations.Backend.MySQL -import Database.Schema.Migrations.Migration ( Migration(..), newMigration ) -import Database.Schema.Migrations.Backend ( Backend(..) ) - -import qualified Database.HDBC as HDBC -import qualified Database.MySQL.Simple as MySQL -import qualified Database.MySQL.Base as MySQL - -data BackendConnection - = forall a. HDBC.IConnection a => HDBCConnection a - | MySQLConnection MySQL.Connection - -migrationBackend :: BackendConnection -> Backend -migrationBackend (HDBCConnection c) = hdbcBackend c -migrationBackend (MySQLConnection c) = mysqlBackend c - -commit :: BackendConnection -> IO () -commit (HDBCConnection c) = HDBC.commit c -commit (MySQLConnection c) = MySQL.commit c - -getTables :: BackendConnection -> IO [String] -getTables (HDBCConnection c) = HDBC.getTables c -getTables (MySQLConnection c) = - fmap (map MySQL.fromOnly) - (MySQL.query_ c "SHOW TABLES") - -catchSql_ :: IO a -> IO a -> IO a -catchSql_ act handler = - act `catches` - [Handler (\(_ :: MySQL.FormatError) -> handler) - ,Handler (\(_ :: MySQL.QueryError) -> handler) - ,Handler (\(_ :: MySQL.MySQLError) -> handler) - ,Handler (\(_ :: MySQL.ResultError) -> handler) - ,Handler (\(_ :: HDBC.SqlError) -> handler)] - -withTransaction - :: BackendConnection -> (BackendConnection -> IO a) -> IO a -withTransaction (HDBCConnection c) transaction = - HDBC.withTransaction c - (transaction . HDBCConnection) -withTransaction (MySQLConnection c) transaction = - MySQL.withTransaction c - (transaction (MySQLConnection c)) -tests :: BackendConnection -> IO () -tests conn = do - let acts = [ isBootstrappedFalseTest - , bootstrapTest - , isBootstrappedTrueTest - , applyMigrationFailure - , applyMigrationSuccess - , revertMigrationFailure - , revertMigrationNothing - , revertMigrationJust - ] - forM_ acts $ \act -> do - commit conn - act conn - -bootstrapTest :: BackendConnection -> IO () -bootstrapTest conn = do - let backend = migrationBackend conn - bs <- getBootstrapMigration backend - applyMigration backend bs - assertEqual "installed_migrations table exists" ["installed_migrations"] =<< getTables conn - assertEqual "successfully bootstrapped" [mId bs] =<< getMigrations backend - -isBootstrappedTrueTest :: BackendConnection -> IO () -isBootstrappedTrueTest conn = do - result <- isBootstrapped $ migrationBackend conn - assertBool "Bootstrapped check" result - -isBootstrappedFalseTest :: BackendConnection -> IO () -isBootstrappedFalseTest conn = do - result <- isBootstrapped $ migrationBackend conn - assertBool "Bootstrapped check" $ not result - -ignoreSqlExceptions :: IO a -> IO (Maybe a) -ignoreSqlExceptions act = (act >>= return . Just) `catchSql_` - (return Nothing) - -applyMigrationSuccess :: BackendConnection -> IO () -applyMigrationSuccess conn = do - let backend = migrationBackend conn - - let m1 = (newMigration "validMigration") { mApply = "CREATE TABLE valid1 (a int); CREATE TABLE valid2 (a int);" } - - -- Apply the migrations, ignore exceptions - withTransaction conn $ \conn' -> applyMigration (migrationBackend conn') m1 - - -- Check that none of the migrations were installed - assertEqual "Installed migrations" ["root", "validMigration"] =<< getMigrations backend - assertEqual "Installed tables" ["installed_migrations", "valid1", "valid2"] =<< getTables conn - --- |Does a failure to apply a migration imply a transaction rollback? -applyMigrationFailure :: BackendConnection -> IO () -applyMigrationFailure conn = do - let backend = migrationBackend conn - - let m1 = (newMigration "second") { mApply = "CREATE TABLE validButTemporary (a int)" } - m2 = (newMigration "third") { mApply = "INVALID SQL" } - - -- Apply the migrations, ignore exceptions - ignoreSqlExceptions $ withTransaction conn $ \conn' -> do - let backend' = migrationBackend conn' - applyMigration backend' m1 - applyMigration backend' m2 - - -- Check that none of the migrations were installed - assertEqual "Installed migrations" ["root"] =<< getMigrations backend - assertEqual "Installed tables" ["installed_migrations"] =<< getTables conn - -revertMigrationFailure :: BackendConnection -> IO () -revertMigrationFailure conn = do - let backend = migrationBackend conn - - let m1 = (newMigration "second") { mApply = "CREATE TABLE validRMF (a int)" - , mRevert = Just "DROP TABLE validRMF"} - m2 = (newMigration "third") { mApply = "SELECT * FROM validRMF" - , mRevert = Just "INVALID REVERT SQL"} - - applyMigration backend m1 - applyMigration backend m2 - - installedBeforeRevert <- getMigrations backend - - commitBackend backend - - -- Revert the migrations, ignore exceptions; the revert will fail, - -- but withTransaction will roll back. - ignoreSqlExceptions $ withTransaction conn $ \conn' -> do - let backend' = migrationBackend conn' - revertMigration backend' m2 - revertMigration backend' m1 - - -- Check that none of the migrations were reverted - assertEqual "successfully roll back failed revert" installedBeforeRevert - =<< getMigrations backend - -revertMigrationNothing :: BackendConnection -> IO () -revertMigrationNothing conn = do - let backend = migrationBackend conn - - let m1 = (newMigration "second") { mApply = "SELECT 1" - , mRevert = Nothing } - - applyMigration backend m1 - - installedAfterApply <- getMigrations backend - assertBool "Check that the migration was applied" $ "second" `elem` installedAfterApply - - -- Revert the migration, which should do nothing EXCEPT remove it - -- from the installed list - revertMigration backend m1 - - installed <- getMigrations backend - assertBool "Check that the migration was reverted" $ not $ "second" `elem` installed - -revertMigrationJust :: BackendConnection -> IO () -revertMigrationJust conn = do - let name = "revertable" - backend = migrationBackend conn - - let m1 = (newMigration name) { mApply = "CREATE TABLE the_test_table (a int)" - , mRevert = Just "DROP TABLE the_test_table" } - - applyMigration backend m1 - - installedAfterApply <- getMigrations backend - assertBool "Check that the migration was applied" $ name `elem` installedAfterApply - - -- Revert the migration, which should do nothing EXCEPT remove it - -- from the installed list - revertMigration backend m1 - - installed <- getMigrations backend - assertBool "Check that the migration was reverted" $ not $ name `elem` installed diff --git a/test/ConfigurationTest.hs b/test/ConfigurationTest.hs --- a/test/ConfigurationTest.hs +++ b/test/ConfigurationTest.hs @@ -24,7 +24,6 @@ prepareTestEnv :: IO () prepareTestEnv = do setCurrentDirectory $ testFile "config_loading" - unsetEnv "DBM_DATABASE_TYPE" unsetEnv "DBM_DATABASE" unsetEnv "DBM_MIGRATION_STORE" unsetEnv "DBM_LINEAR_MIGRATIONS" @@ -46,7 +45,6 @@ return ( _connectionString cfg ~?= "connection" .&&. - _databaseType cfg ~?= "dbtype" .&&. _migrationStorePath cfg ~?= "store" .&&. _linearMigrations cfg ~?= True ) @@ -57,14 +55,12 @@ return ( _connectionString cfg ~?= "mooconn" .&&. - _databaseType cfg ~?= "moodb" .&&. _migrationStorePath cfg ~?= "moostore" .&&. _linearMigrations cfg ~?= True ) environmentOverridesProperties :: IO Test environmentOverridesProperties = do - setEnv "DBM_DATABASE_TYPE" "envdb" setEnv "DBM_DATABASE" "envconn" setEnv "DBM_MIGRATION_STORE" "envstore" setEnv "DBM_LINEAR_MIGRATIONS" "off" @@ -72,7 +68,6 @@ return ( _connectionString cfg ~?= "envconn" .&&. - _databaseType cfg ~?= "envdb" .&&. _migrationStorePath cfg ~?= "envstore" .&&. _linearMigrations cfg ~?= False ) @@ -80,7 +75,6 @@ ifNoConfigFileIsAvailableEnvironmentIsUsed :: IO Test ifNoConfigFileIsAvailableEnvironmentIsUsed = do setCurrentDirectory $ testFile "" - setEnv "DBM_DATABASE_TYPE" "envdb" setEnv "DBM_DATABASE" "envconn" setEnv "DBM_MIGRATION_STORE" "envstore" setEnv "DBM_LINEAR_MIGRATIONS" "off" @@ -88,7 +82,6 @@ return ( _connectionString cfg ~?= "envconn" .&&. - _databaseType cfg ~?= "envdb" .&&. _migrationStorePath cfg ~?= "envstore" .&&. _linearMigrations cfg ~?= False ) diff --git a/test/LinearMigrationsTest.hs b/test/LinearMigrationsTest.hs --- a/test/LinearMigrationsTest.hs +++ b/test/LinearMigrationsTest.hs @@ -6,7 +6,6 @@ import Common import Control.Monad.Reader (runReaderT) import Data.Either (isRight) -import Data.Maybe (isNothing) import Database.Schema.Migrations.Migration import Database.Schema.Migrations.Store import Moo.CommandHandlers @@ -73,12 +72,11 @@ Right storeData <- loadMigrations store return AppState { _appOptions = CommandOptions Nothing False True + , _appBackend = undefined -- Not used here , _appCommand = undefined -- Not used by newCommand , _appRequiredArgs = [m] , _appOptionalArgs = [] , _appStore = store - , _appDatabaseConnStr = DbConnDescriptor "" - , _appDatabaseType = "none" , _appStoreData = storeData , _appLinearMigrations = True , _appTimestampFilenames = False diff --git a/test/TestDriver.hs b/test/TestDriver.hs --- a/test/TestDriver.hs +++ b/test/TestDriver.hs @@ -1,11 +1,9 @@ module Main where -import Prelude hiding ( catch ) +import Prelude import Test.HUnit import System.Exit -import System.Process ( system ) import System.IO ( stderr ) -import qualified BackendTest import qualified DependencyTest import qualified MigrationsTest import qualified FilesystemSerializeTest @@ -16,33 +14,11 @@ import qualified LinearMigrationsTest import qualified ConfigurationTest -import Control.Monad ( forM ) -import Control.Exception ( finally, catch, try, SomeException(..) ) -import Data.String (fromString) - -import Database.HDBC ( IConnection(disconnect) ) -import Database.HDBC.Sqlite3 ( connectSqlite3 ) -import qualified Database.HDBC.PostgreSQL as PostgreSQL -import qualified Database.MySQL.Simple as MySQL +import Control.Exception ( SomeException(..) ) loadTests :: IO [Test] loadTests = do - sqliteConn <- connectSqlite3 ":memory:" - --pgConn <- setupPostgresDb - mysqlConn <- setupMySQLDb - - let backends = [ ("Sqlite", (BackendTest.tests (BackendTest.HDBCConnection sqliteConn)) `finally` - (disconnect sqliteConn)) - -- , ("PostgreSQL", (BackendTest.tests (BackendTest.HDBCConnection pgConn)) `finally` - -- (disconnect pgConn >> teardownPostgresDb)) - , ("MySQL", (BackendTest.tests (BackendTest.MySQLConnection mysqlConn)) `finally` - (MySQL.close mysqlConn >> teardownMySQLDb)) - ] - - backendTests <- forM backends $ \(name, testAct) -> do - return $ (name ++ " backend tests") ~: test testAct - ioTests <- sequence [ do fspTests <- FilesystemParseTest.tests return $ "Filesystem Parsing" ~: test fspTests , do fsTests <- FilesystemTest.tests @@ -52,8 +28,7 @@ , do cfgTests <- ConfigurationTest.tests return $ "Configuration tests" ~: test cfgTests ] - return $ concat [ backendTests - , ioTests + return $ concat [ ioTests , DependencyTest.tests , FilesystemSerializeTest.tests , MigrationsTest.tests @@ -66,43 +41,6 @@ ignoreException :: SomeException -> IO () ignoreException _ = return () - -setupPostgresDb :: IO PostgreSQL.Connection -setupPostgresDb = do - teardownPostgresDb `catch` ignoreException - - -- create database - status <- system $ "createdb " ++ tempDatabase - case status of - ExitSuccess -> return () - ExitFailure _ -> error $ "Failed to create PostgreSQL database " ++ (show tempDatabase) - - -- return test db connection - PostgreSQL.connectPostgreSQL $ "dbname=" ++ tempDatabase - -teardownPostgresDb :: IO () -teardownPostgresDb = do - -- drop database - status <- system $ "dropdb " ++ tempDatabase ++ " 2>/dev/null" - case status of - ExitSuccess -> return () - ExitFailure _ -> error $ "Failed to drop PostgreSQL database " ++ (show tempDatabase) - -setupMySQLDb :: IO MySQL.Connection -setupMySQLDb = do - teardownMySQLDb `catch` ignoreException - conn <- MySQL.connect MySQL.defaultConnectInfo - MySQL.execute_ conn (fromString ("CREATE DATABASE " ++ tempDatabase)) - MySQL.execute_ conn (fromString ("USE " ++ tempDatabase)) - pure conn - -teardownMySQLDb :: IO () -teardownMySQLDb = do - conn <- MySQL.connect MySQL.defaultConnectInfo - e <- try (MySQL.execute_ conn (fromString ("DROP DATABASE " ++ tempDatabase))) - case e of - Left ex@SomeException{} -> error ("Failed to drop test MySQL database: " ++ show ex) - Right _ -> return () main :: IO () main = do diff --git a/test/config_loading/cfg1.cfg b/test/config_loading/cfg1.cfg new file mode 100644 --- /dev/null +++ b/test/config_loading/cfg1.cfg @@ -0,0 +1,3 @@ +DBM_DATABASE = "connection" +DBM_MIGRATION_STORE = "store" +DBM_LINEAR_MIGRATIONS = on diff --git a/test/config_loading/cfg_ts.cfg b/test/config_loading/cfg_ts.cfg new file mode 100644 --- /dev/null +++ b/test/config_loading/cfg_ts.cfg @@ -0,0 +1,4 @@ +DBM_DATABASE = "connection" +DBM_MIGRATION_STORE = "store" +DBM_LINEAR_MIGRATIONS = on +DBM_TIMESTAMP_FILENAMES = true diff --git a/test/config_loading/invalid.cfg b/test/config_loading/invalid.cfg new file mode 100644 --- /dev/null +++ b/test/config_loading/invalid.cfg @@ -0,0 +1,3 @@ +MALFORMED_ = +CONFIG = ASD +FILE diff --git a/test/config_loading/missing.cfg b/test/config_loading/missing.cfg new file mode 100644 --- /dev/null +++ b/test/config_loading/missing.cfg diff --git a/test/config_loading/moo.cfg b/test/config_loading/moo.cfg new file mode 100644 --- /dev/null +++ b/test/config_loading/moo.cfg @@ -0,0 +1,3 @@ +DBM_DATABASE = "mooconn" +DBM_MIGRATION_STORE = "moostore" +DBM_LINEAR_MIGRATIONS = on diff --git a/test/migration_parsing/valid_no_timestamp.txt b/test/migration_parsing/valid_no_timestamp.txt new file mode 100644 --- /dev/null +++ b/test/migration_parsing/valid_no_timestamp.txt @@ -0,0 +1,9 @@ +Description: A valid full migration. +Depends: another_migration +Apply: + + CREATE TABLE test ( + a int + ); + +Revert: DROP TABLE test;