dbmigrations 0.2 → 0.3

raw patch · 5 files changed

+90/−26 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• MOO.TXT +6/−0
• dbmigrations.cabal +7/−7
• src/Database/Schema/Migrations/Backend.hs +7/−0
• src/Database/Schema/Migrations/Backend/HDBC.hs +4/−2
• src/Moo.hs +66/−17

@@ -76,3 +76,9 @@     command would apply if you were to run it.  In other words, this     will list all migrations which have not yet been applied to the     database.++  reinstall: this will revert, then reapply a migration, all in a+    transaction.  If --test is specified, the transaction will be+    rolled back; otherwise it will be committed.  This is mostly+    useful in development when a migration applies but is incorrect+    and needs to be tweaked and reapplied.

@@ -1,5 +1,5 @@ Name:                dbmigrations-Version:             0.2+Version:             0.3 Synopsis:            An implementation of relational database "migrations" Description:         A library and program for the creation,                      management, and installation of schema updates@@ -34,10 +34,10 @@  Library   if impl(ghc >= 6.12.0)-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields                  -fno-warn-unused-do-bind   else-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields    Build-Depends:     base >= 4 && < 5,@@ -75,10 +75,10 @@     process >= 1.0 && < 1.1    if impl(ghc >= 6.12.0)-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields                  -fno-warn-unused-do-bind -Wwarn   else-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields    if !flag(testing)     Buildable:     False@@ -92,10 +92,10 @@     HDBC-sqlite3    if impl(ghc >= 6.12.0)-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields                  -fno-warn-unused-do-bind   else-    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields    Hs-Source-Dirs:  src   Main-is:         Moo.hs

@@ -1,11 +1,18 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Database.Schema.Migrations.Backend     ( Backend(..)+    , rootMigrationName     ) where  import Database.Schema.Migrations.Migration     ( Migration(..) )++-- |Backend instances should use this as the name of the migration+-- returned by getBootstrapMigration; this migration is special+-- because it cannot be reverted.+rootMigrationName :: String+rootMigrationName = "root"  -- |A Backend represents a database engine backend such as MySQL or -- SQLite.  A Backend supplies relatively low-level functions for

@@ -7,7 +7,9 @@ import Database.HDBC ( quickQuery', fromSql, toSql, IConnection(getTables, run, runRaw) )  import Database.Schema.Migrations.Backend-    ( Backend(..) )+    ( Backend(..)+    , rootMigrationName+    ) import Database.Schema.Migrations.Migration     ( Migration(..)     , newMigration@@ -33,7 +35,7 @@      getBootstrapMigration _ =         do-          m <- newMigration "root"+          m <- newMigration rootMigrationName           return $ m { mApply = createSql                      , mRevert = Just revertSql                      , mDesc = Just "Migration table installation"

@@ -25,7 +25,8 @@ import Database.Schema.Migrations.Filesystem import Database.Schema.Migrations.Migration ( Migration(..) ) import Database.Schema.Migrations.Backend ( Backend, applyMigration-                                          , revertMigration+                                          , revertMigration, getMigrations+                                          , rootMigrationName                                           ) import Database.Schema.Migrations.Store ( loadMigrations                                         , fullMigrationName@@ -170,10 +171,10 @@ commands = [ Command "new" ["migration_name"] [] [NoAsk]                          "Create a new empty migration"                          newCommand-           , Command "apply" ["migration_name"] [] []+           , Command "apply" ["migration_name"] [] [Test]                          "Apply the specified migration and its dependencies"                          applyCommand-           , Command "revert" ["migration_name"] [] []+           , Command "revert" ["migration_name"] [] [Test]                          "Revert the specified migration and those that depend\                           \ on it"                           revertCommand@@ -186,9 +187,14 @@                          \installed"                          upgradeCommand            , Command "upgrade-list" [] [] []-                         "Show the list of migrations to be installed during \-                         \an upgrade"+                         "Show the list of migrations not yet installed"                          upgradeListCommand+           , Command "reinstall" ["migration_name"] [] [Test]+                         "Reinstall a migration by reverting, then reapplying it"+                         reinstallCommand+           , Command "list" [] [] []+                         "List migrations already installed in the backend"+                         listCommand            ]  -- The values of DBM_DATABASE_TYPE and their corresponding connection@@ -340,7 +346,7 @@                            exitSuccess         forM_ migrationNames $ \migrationName -> do             m <- lookupMigration storeData migrationName-            apply m storeData conn+            apply m storeData conn False         case isTesting of           True -> do                  rollback conn@@ -366,8 +372,8 @@   exitWith (ExitFailure 1)  apply :: (IConnection b, Backend b IO)-         => Migration -> StoreData -> b -> IO [Migration]-apply m storeData backend = do+         => Migration -> StoreData -> b -> Bool -> IO [Migration]+apply m storeData backend complain = do   -- Get the list of migrations to apply   toApply <- migrationsToApply storeData backend m @@ -378,9 +384,10 @@      where       nothingToDo = do-        putStrLn $ "Nothing to do; " ++-                     (mId m) ++-                     " already installed."+        when complain $+             putStrLn $ "Nothing to do; " +++                          (mId m) +++                          " already installed."        applyIt conn it = do         putStr $ "Applying: " ++ mId it ++ "... "@@ -418,20 +425,56 @@       exitWith (ExitFailure 1)     Just m' -> return m' +reinstallCommand :: CommandHandler+reinstallCommand storeData = do+  isTesting <- hasOption Test+  required <- asks appRequiredArgs+  let [migrationId] = required++  withConnection $ \(AnyIConnection conn) -> do+      ensureBootstrappedBackend conn >> commit conn+      m <- lookupMigration storeData migrationId++      revert m storeData conn+      apply m storeData conn True++      case isTesting of+        False -> do+          commit conn+          putStrLn "Migration successfully reinstalled."+        True -> do+          rollback conn+          putStrLn "Reinstall test successful."++listCommand :: CommandHandler+listCommand _ = do+  withConnection $ \(AnyIConnection conn) -> do+      ensureBootstrappedBackend conn >> commit conn+      ms <- getMigrations conn+      forM_ ms $ \m ->+          when (not $ m == rootMigrationName) $ putStrLn m+ applyCommand :: CommandHandler applyCommand storeData = do+  isTesting <- hasOption Test   required <- asks appRequiredArgs   let [migrationId] = required    withConnection $ \(AnyIConnection conn) -> do         ensureBootstrappedBackend conn >> commit conn         m <- lookupMigration storeData migrationId-        apply m storeData conn-        commit conn-        putStrLn "Successfully applied migrations."+        apply m storeData conn True+        case isTesting of+          False -> do+            commit conn+            putStrLn "Successfully applied migrations."+          True -> do+            rollback conn+            putStrLn "Migration installation test successful."  revertCommand :: CommandHandler revertCommand storeData = do+  isTesting <- hasOption Test   required <- asks appRequiredArgs   let [migrationId] = required @@ -439,9 +482,15 @@       ensureBootstrappedBackend conn >> commit conn       m <- lookupMigration storeData migrationId       revert m storeData conn-      commit conn-      putStrLn "Successfully reverted migrations." +      case isTesting of+        False -> do+          commit conn+          putStrLn "Successfully reverted migrations."+        True -> do+          rollback conn+          putStrLn "Migration uninstallation test successful."+ testCommand :: CommandHandler testCommand storeData = do   required <- asks appRequiredArgs@@ -456,7 +505,7 @@         when (not $ migrationId `elem` migrationNames) $              do revert m storeData conn                 return ()-        applied <- apply m storeData conn+        applied <- apply m storeData conn True         forM_ (reverse applied) $ \migration -> do                              revert migration storeData conn         rollback conn