dbmigrations 0.8.1 → 0.8.2

raw patch · 28 files changed

+1077/−114 lines, 28 filesdep ~HUnitdep ~bytestringdep ~configuratorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: HUnit, bytestring, configurator, containers, directory, fgl, filepath, mtl, random, text, time, yaml-light

API changes (from Hackage documentation)

Files

• dbmigrations.cabal +65/−33
• src/Moo.hs +9/−81
• src/Moo/Main.hs +99/−0
• test/BackendTest.hs +143/−0
• test/Common.hs +28/−0
• test/CommonTH.hs +16/−0
• test/CycleDetectionTest.hs +69/−0
• test/DependencyTest.hs +79/−0
• test/FilesystemParseTest.hs +117/−0
• test/FilesystemSerializeTest.hs +74/−0
• test/FilesystemTest.hs +33/−0
• test/MigrationsTest.hs +72/−0
• test/StoreTest.hs +118/−0
• test/example_store/root +10/−0
• test/example_store/update1 +10/−0
• test/example_store/update2 +10/−0
• test/migration_parsing/invalid_field_name.txt +11/−0
• test/migration_parsing/invalid_missing_required_fields.txt +8/−0
• test/migration_parsing/invalid_syntax.txt +9/−0
• test/migration_parsing/invalid_timestamp.txt +10/−0
• test/migration_parsing/valid_full.txt +10/−0
• test/migration_parsing/valid_no_depends.txt +10/−0
• test/migration_parsing/valid_no_desc.txt +9/−0
• test/migration_parsing/valid_no_revert.txt +8/−0
• test/migration_parsing/valid_with_colon.txt +11/−0
• test/migration_parsing/valid_with_comments.txt +13/−0
• test/migration_parsing/valid_with_comments2.txt +11/−0
• test/migration_parsing/valid_with_multiline_deps.txt +15/−0

@@ -1,5 +1,5 @@ Name:                dbmigrations-Version:             0.8.1+Version:             0.8.2 Synopsis:            An implementation of relational database "migrations" Description:         A library and program for the creation,                      management, and installation of schema updates@@ -25,8 +25,26 @@ License:             BSD3 License-File:        LICENSE Cabal-Version:       >= 1.10-Data-Files:          README.md MOO.TXT +Data-Files:+  README.md+  MOO.TXT+  test/example_store/root+  test/example_store/update1+  test/example_store/update2+  test/migration_parsing/invalid_field_name.txt+  test/migration_parsing/invalid_missing_required_fields.txt+  test/migration_parsing/invalid_syntax.txt+  test/migration_parsing/invalid_timestamp.txt+  test/migration_parsing/valid_full.txt+  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_with_colon.txt+  test/migration_parsing/valid_with_comments.txt+  test/migration_parsing/valid_with_comments2.txt+  test/migration_parsing/valid_with_multiline_deps.txt+ Source-Repository head   type:     git   location: git://github.com/jtdaugherty/dbmigrations.git@@ -42,18 +60,18 @@   Build-Depends:     base >= 4 && < 5,     HDBC >= 2.2.1,-    time >= 1.4 && < 1.6,-    random >= 1.0 && < 1.2,-    containers >= 0.2 && < 0.6,-    mtl >= 2.1 && < 3,-    filepath >= 1.1 && < 1.4,-    directory >= 1.0 && < 1.3,-    fgl >= 5.4 && < 5.6,+    time >= 1.4,+    random >= 1.0,+    containers >= 0.2,+    mtl >= 2.1,+    filepath >= 1.1,+    directory >= 1.0,+    fgl >= 5.4,     template-haskell,-    yaml-light >= 0.1 && < 0.2,-    bytestring >= 0.9 && < 1.0,-    text >= 0.11 && < 1.3,-    configurator >= 0.2 && < 0.4,+    yaml-light >= 0.1,+    bytestring >= 0.9,+    text >= 0.11,+    configurator >= 0.2,     HDBC-postgresql,     HDBC-sqlite3 @@ -66,6 +84,7 @@           Database.Schema.Migrations.Backend           Database.Schema.Migrations.Backend.HDBC           Database.Schema.Migrations.Store+          Moo.Main    Other-Modules:           Database.Schema.Migrations.CycleDetection@@ -80,21 +99,34 @@   type: exitcode-stdio-1.0   Build-Depends:     base >= 4 && < 5,-    time >= 1.4 && < 1.6,-    containers >= 0.2 && < 0.6,-    mtl >= 2.1 && < 3,-    filepath >= 1.1 && < 1.4,-    directory >= 1.0 && < 1.3,-    fgl >= 5.4 && < 5.6,+    time >= 1.4,+    containers >= 0.2,+    mtl >= 2.1,+    filepath >= 1.1,+    directory >= 1.0,+    fgl >= 5.4,     template-haskell,-    yaml-light >= 0.1 && < 0.2,-    bytestring >= 0.9 && < 1.0,+    yaml-light >= 0.1,+    bytestring >= 0.9,     HDBC >= 2.2.1,     HDBC-postgresql,     HDBC-sqlite3,-    HUnit >= 1.2 && < 1.3,+    HUnit >= 1.2,     process >= 1.1 +  other-modules:+    BackendTest+    Common+    CommonTH+    CycleDetectionTest+    DependencyTest+    FilesystemParseTest+    FilesystemSerializeTest+    FilesystemTest+    MigrationsTest+    StoreTest+    TestDriver+   if impl(ghc >= 6.12.0)     ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields                  -fno-warn-unused-do-bind -Wwarn@@ -109,18 +141,18 @@   Build-Depends:     base >= 4 && < 5,     HDBC >= 2.2.1,-    time >= 1.4 && < 1.6,-    random >= 1.0 && < 1.2,-    containers >= 0.2 && < 0.6,-    mtl >= 2.1 && < 3,-    filepath >= 1.1 && < 1.4,-    directory >= 1.0 && < 1.3,-    fgl >= 5.4 && < 5.6,+    time >= 1.4,+    random >= 1.0,+    containers >= 0.2,+    mtl >= 2.1,+    filepath >= 1.1,+    directory >= 1.0,+    fgl >= 5.4,     template-haskell,-    yaml-light >= 0.1 && < 0.2,-    bytestring >= 0.9 && < 1.0,-    text >= 0.11 && < 1.3,-    configurator >= 0.2 && < 0.4,+    yaml-light >= 0.1,+    bytestring >= 0.9,+    text >= 0.11,+    configurator >= 0.2,     HDBC-postgresql,     HDBC-sqlite3 

@@ -1,50 +1,15 @@ module Main-    ( main )+    ( main+    ) where  import  Control.Monad (liftM)-import  Control.Monad.Reader (forM_, runReaderT, when) import  Data.Configurator-import  Data.List (intercalate)-import  Data.Maybe (fromMaybe)-import  Database.HDBC (SqlError, catchSql, seErrorMsg) import  Prelude  hiding (lookup)-import  System.Environment (getArgs, getEnvironment, getProgName)-import  System.Exit (ExitCode (ExitFailure), exitWith)-                                               -import  Database.Schema.Migrations.Filesystem (FilesystemStore (..))-import  Database.Schema.Migrations.Store-import  Moo.CommandInterface-import  Moo.Core--reportSqlError :: SqlError -> IO a-reportSqlError e = do-  putStrLn $ "\n" ++ "A database error occurred: " ++ seErrorMsg e-  exitWith (ExitFailure 1)--usage :: IO a-usage = do-  progName <- getProgName--  putStrLn $ "Usage: " ++ progName ++ " <command> [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 "Commands:"-  forM_ commands $ \command -> do-          putStrLn $ "  " ++ usageString command-          putStrLn $ "  " ++ _cDescription command-          putStrLn ""--  putStrLn commandOptionUsage-  exitWith (ExitFailure 1)+import  System.Environment (getArgs, getEnvironment) -usageSpecific :: Command -> IO a-usageSpecific command = do-  putStrLn $ "Usage: initstore-fs " ++ usageString command-  exitWith (ExitFailure 1)+import  Moo.Core+import  Moo.Main  loadConfiguration :: Maybe FilePath -> IO Configuration loadConfiguration Nothing = liftM fromShellEnvironment getEnvironment@@ -52,44 +17,7 @@  main :: IO () main = do-  allArgs <- getArgs-  when (null allArgs) usage-  let (commandName:unprocessedArgs) = allArgs--  command <- case findCommand commandName of-               Nothing -> usage-               Just c -> return c--  (opts, required) <- getCommandArgs unprocessedArgs--  let optionalConfigPath = _configFilePath opts--  conf <- loadConfiguration optionalConfigPath-  let mDbConnStr = _connectionString conf-  let mDbType = _databaseType conf-  let mStoreName = _migrationStorePath conf-  let  storePathStr =-         fromMaybe (error $ "Error: missing required environment variable " ++ envStoreName)-                   mStoreName--  let  store = FSStore { storePath = storePathStr }--  if length required < length ( _cRequired command) then-      usageSpecific command else-      do-        loadedStoreData <- loadMigrations store-        case loadedStoreData of-          Left es -> do-            putStrLn "There were errors in the migration store:"-            forM_ es $ \err -> putStrLn $ "  " ++ show err-          Right storeData -> do-            let st = AppState { _appOptions = opts-                              , _appCommand = command-                              , _appRequiredArgs = required-                              , _appOptionalArgs = ["" :: String]-                              , _appDatabaseConnStr = liftM DbConnDescriptor mDbConnStr-                              , _appDatabaseType = mDbType-                              , _appStore = FSStore storePathStr-                              , _appStoreData = storeData-                              }-            runReaderT (_cHandler command storeData) st `catchSql` reportSqlError+  args <- getArgs+  (_, opts, _) <- procArgs args+  conf <- loadConfiguration $ _configFilePath opts+  mainWithConf args conf

@@ -0,0 +1,99 @@+module Moo.Main+    ( mainWithConf+    , Configuration (..)+    , Args+    , usage+    , usageSpecific+    , procArgs+    )+where++import  Control.Monad (liftM)+import  Control.Monad.Reader (forM_, runReaderT, when)+import  Data.List (intercalate)+import  Data.Maybe (fromMaybe)+import  Database.HDBC (SqlError, catchSql, seErrorMsg)+import  Prelude  hiding (lookup)+import  System.Environment (getProgName)+import  System.Exit (ExitCode (ExitFailure), exitWith)++import  Database.Schema.Migrations.Filesystem (FilesystemStore (..))+import  Database.Schema.Migrations.Store+import  Moo.CommandInterface+import  Moo.Core++type Args = [String]++usage :: IO a+usage = do+  progName <- getProgName++  putStrLn $ "Usage: " ++ progName ++ " <command> [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 "Commands:"+  forM_ commands $ \command -> do+          putStrLn $ "  " ++ usageString command+          putStrLn $ "  " ++ _cDescription command+          putStrLn ""++  putStrLn commandOptionUsage+  exitWith (ExitFailure 1)++usageSpecific :: Command -> IO a+usageSpecific command = do+  putStrLn $ "Usage: initstore-fs " ++ usageString command+  exitWith (ExitFailure 1)++procArgs :: Args -> IO (Command, CommandOptions, [String])+procArgs args = do+  when (null args) usage++  command <- case findCommand $ head args of+               Nothing -> usage+               Just c -> return c++  (opts, required) <- getCommandArgs $ tail args++  return (command, opts, required)++mainWithConf :: Args -> Configuration -> IO ()+mainWithConf args conf = do+  (command, opts, required) <- procArgs args++  let mDbConnStr = _connectionString conf+  let mDbType = _databaseType conf+  let mStoreName = _migrationStorePath conf+  let  storePathStr =+         fromMaybe (error $ "Error: missing required environment variable " ++ envStoreName)+                   mStoreName++  let  store = FSStore { storePath = storePathStr }++  if length required < length ( _cRequired command) then+      usageSpecific command else+      do+        loadedStoreData <- loadMigrations store+        case loadedStoreData of+          Left es -> do+            putStrLn "There were errors in the migration store:"+            forM_ es $ \err -> putStrLn $ "  " ++ show err+          Right storeData -> do+            let st = AppState { _appOptions = opts+                              , _appCommand = command+                              , _appRequiredArgs = required+                              , _appOptionalArgs = ["" :: String]+                              , _appDatabaseConnStr = liftM DbConnDescriptor mDbConnStr+                              , _appDatabaseType = mDbType+                              , _appStore = FSStore storePathStr+                              , _appStoreData = storeData+                              }+            runReaderT (_cHandler command storeData) st `catchSql` reportSqlError++reportSqlError :: SqlError -> IO a+reportSqlError e = do+  putStrLn $ "\n" ++ "A database error occurred: " ++ seErrorMsg e+  exitWith (ExitFailure 1)

@@ -0,0 +1,143 @@+module BackendTest where++import Test.HUnit+import Control.Monad ( forM_ )++import Database.Schema.Migrations.Backend.HDBC ()+import Database.Schema.Migrations.Migration ( Migration(..), newMigration )+import Database.Schema.Migrations.Backend ( Backend(..) )++import Database.HDBC ( IConnection(..), catchSql, withTransaction )++tests :: (IConnection a) => a -> IO ()+tests conn = do+  let acts = [ isBootstrappedFalseTest+             , bootstrapTest+             , isBootstrappedTrueTest+             , applyMigrationFailure+             , applyMigrationSuccess+             , revertMigrationFailure+             , revertMigrationNothing+             , revertMigrationJust+             ]+  forM_ acts $ \act -> do+               commit conn+               act conn++bootstrapTest :: (IConnection a) => a -> IO ()+bootstrapTest conn = do+  bs <- getBootstrapMigration conn+  applyMigration conn bs+  assertEqual "installed_migrations table exists" ["installed_migrations"] =<< getTables conn+  assertEqual "successfully bootstrapped" [mId bs] =<< getMigrations conn++isBootstrappedTrueTest :: (IConnection a) => a -> IO ()+isBootstrappedTrueTest conn = do+  result <- isBootstrapped conn+  assertBool "Bootstrapped check" result++isBootstrappedFalseTest :: (IConnection a) => a -> IO ()+isBootstrappedFalseTest conn = do+  result <- isBootstrapped conn+  assertBool "Bootstrapped check" $ not result++ignoreSqlExceptions :: IO a -> IO (Maybe a)+ignoreSqlExceptions act = (act >>= return . Just) `catchSql`+                       (\_ -> return Nothing)++applyMigrationSuccess :: (IConnection a) => a -> IO ()+applyMigrationSuccess conn = do+    m1 <- newMigration "validMigration"++    let m1' = m1 { mApply = "CREATE TABLE valid1 (a int); CREATE TABLE valid2 (a int);" }++    -- Apply the migrations, ignore exceptions+    withTransaction conn $ \conn' -> applyMigration conn' m1'++    -- Check that none of the migrations were installed+    assertEqual "Installed migrations" ["root", "validMigration"] =<< getMigrations conn+    assertEqual "Installed tables" ["installed_migrations", "valid1", "valid2"] =<< getTables conn++-- |Does a failure to apply a migration imply a transaction rollback?+applyMigrationFailure :: (IConnection a) => a -> IO ()+applyMigrationFailure conn = do+    m1 <- newMigration "second"+    m2 <- newMigration "third"++    let m1' = m1 { mApply = "CREATE TABLE validButTemporary (a int)" }+    let m2' = m2 { mApply = "INVALID SQL" }++    -- Apply the migrations, ignore exceptions+    ignoreSqlExceptions $ withTransaction conn $ \conn' -> do+                               applyMigration conn' m1'+                               applyMigration conn' m2'++    -- Check that none of the migrations were installed+    assertEqual "Installed migrations" ["root"] =<< getMigrations conn+    assertEqual "Installed tables" ["installed_migrations"] =<< getTables conn++revertMigrationFailure :: (IConnection a) => a -> IO ()+revertMigrationFailure conn = do+    m1 <- newMigration "second"+    m2 <- newMigration "third"++    let m1' = m1 { mApply = "CREATE TABLE validRMF (a int)"+                 , mRevert = Just "DROP TABLE validRMF"}+    let m2' = m2 { mApply = "SELECT * FROM validRMF"+                 , mRevert = Just "INVALID REVERT SQL"}++    applyMigration conn m1'+    applyMigration conn m2'++    installedBeforeRevert <- getMigrations conn++    commit conn++    -- Revert the migrations, ignore exceptions; the revert will fail,+    -- but withTransaction will roll back.+    ignoreSqlExceptions $ withTransaction conn $ \conn' -> do+      revertMigration conn' m2'+      revertMigration conn' m1'++    -- Check that none of the migrations were reverted+    assertEqual "successfully roll back failed revert" installedBeforeRevert+        =<< getMigrations conn++revertMigrationNothing :: (IConnection a) => a -> IO ()+revertMigrationNothing conn = do+    m1 <- newMigration "second"++    let m1' = m1 { mApply = "SELECT 1"+                 , mRevert = Nothing }++    applyMigration conn m1'++    installedAfterApply <- getMigrations conn+    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 conn m1'++    installed <- getMigrations conn+    assertBool "Check that the migration was reverted" $ not $ "second" `elem` installed++revertMigrationJust :: (IConnection a) => a -> IO ()+revertMigrationJust conn = do+    let name = "revertable"+    m1 <- newMigration name++    let m1' = m1 { mApply = "CREATE TABLE the_test_table (a int)"+                 , mRevert = Just "DROP TABLE the_test_table" }++    applyMigration conn m1'++    installedAfterApply <- getMigrations conn+    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 conn m1'++    installed <- getMigrations conn+    assertBool "Check that the migration was reverted" $ not $ name `elem` installed

@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell #-}+module Common+    ( TestDependable(..)+    , repoRoot+    , testFile+    )+where++import CommonTH+import System.FilePath ( (</>) )+import Language.Haskell.TH.Syntax (lift)++import Database.Schema.Migrations.Dependencies ( Dependable(..) )++repoRoot :: FilePath+repoRoot = $(getRepoRoot >>= lift)++testFile :: FilePath -> FilePath+testFile fp = repoRoot </> "test" </> fp++instance Dependable TestDependable where+    depId = tdId+    depsOf = tdDeps++data TestDependable = TD { tdId :: String+                         , tdDeps :: [String]+                         }+                      deriving (Show, Eq, Ord)

@@ -0,0 +1,16 @@+module CommonTH+    ( getRepoRoot+    )+where++import Language.Haskell.TH+import System.FilePath ( takeDirectory, combine )+import System.Directory ( getCurrentDirectory, canonicalizePath )++getRepoRoot :: Q FilePath+getRepoRoot =+    do here <- location+       cwd <- runIO getCurrentDirectory+       let thisFileName = combine cwd $ loc_filename here+       -- XXX: This depends on the location of this file in the source tree+       return =<< runIO $ canonicalizePath $ head $ drop 2 $ iterate takeDirectory thisFileName

@@ -0,0 +1,69 @@+module CycleDetectionTest+    ( tests+    )+where++import Test.HUnit+import Data.Graph.Inductive.PatriciaTree ( Gr )+import Data.Graph.Inductive.Graph ( mkGraph )++import Database.Schema.Migrations.CycleDetection++tests :: [Test]+tests = mkCycleTests++noCycles :: Gr String String+noCycles = mkGraph [(1,"one"),(2,"two")] [(1,2,"one->two")]++noCyclesEmpty :: Gr String String+noCyclesEmpty = mkGraph [] []++withCycleSimple :: Gr String String+withCycleSimple = mkGraph [(1,"one")] [(1,1,"one->one")]++withCycleComplex :: Gr String String+withCycleComplex = mkGraph [(1,"one"),(2,"two"),(3,"three"),(4,"four")]+                     [(4,1,"four->one"),(1,2,"one->two"),(2,3,"two->three"),(3,1,"three->one")]++withCycleRadial :: Gr String String+withCycleRadial = mkGraph [(1,"one"),(2,"two"),(3,"three"),(4,"four")]+                     [(2,1,""),(2,3,""),(3,4,""),(3,2,"")]++noCycleRadial :: Gr String String+noCycleRadial = mkGraph [(1,""),(2,""),(3,""),(4,"")]+                  [(1,2,""),(3,1,""),(4,1,"")]++-- This graph would contain a loop if it were undirected, but it does+-- not contain a directed cycle.+noDirectedCycle1 :: Gr String String+noDirectedCycle1 = mkGraph [(1,""),(2,""),(3,""),(4,"")]+                   [(1,2,""),(1,3,""),(3,2,""),(2,4,"")]++-- This graph would contain a loop if it were undirected, but it does+-- not contain a directed cycle.+noDirectedCycle2 :: Gr String String+noDirectedCycle2 = mkGraph [(1,"flub"),(2,"test.db"),(3,"test2"),(4,"test3"),(5,"test1")]+                   [ (1,2,"flub->test.db")+                   , (2,3,"test.db->test2")+                   , (2,4,"test.db->test3")+                   , (3,5,"test2->test1")+                   , (4,3,"test3->test2")+                   ]++type CycleTestCase = (Gr String String, Bool)++cycleTests :: [CycleTestCase]+cycleTests = [ (noCyclesEmpty, False)+             , (noCycles, False)+             , (noCycleRadial, False)+             , (withCycleSimple, True)+             , (withCycleComplex, True)+             , (withCycleRadial, True)+             , (noDirectedCycle1, False)+             , (noDirectedCycle2, False)+             ]++mkCycleTests :: [Test]+mkCycleTests = map mkCycleTest cycleTests+    where+      mkCycleTest (g, expected) = expected ~=? hasCycle g

@@ -0,0 +1,79 @@+module DependencyTest+    ( tests+    )+where++import Test.HUnit+import Data.Graph.Inductive.Graph ( Graph(..) )++import Database.Schema.Migrations.Dependencies+import Common++tests :: [Test]+tests = depGraphTests ++ dependencyTests++type DepGraphTestCase = ([TestDependable], Either String (DependencyGraph TestDependable))++depGraphTestCases :: [DepGraphTestCase]+depGraphTestCases = [ ( []+                     , Right $ DG [] [] empty+                      )+                    , ( [first, second]+                      , Right $ DG [(first,1),(second,2)]+                                  [("first",1),("second",2)] (mkGraph [(1, "first"), (2, "second")]+                                                              [(2, 1, "first -> second")])+                      )+                    , ( [cycleFirst, cycleSecond]+                      , Left "Invalid dependency graph; cycle detected")+                    ]+    where+      first = TD "first" []+      second = TD "second" ["first"]+      cycleFirst = TD "first" ["second"]+      cycleSecond = TD "second" ["first"]++depGraphTests :: [Test]+depGraphTests = map mkDepGraphTest depGraphTestCases++mkDepGraphTest :: DepGraphTestCase -> Test+mkDepGraphTest (input, expected) = expected ~=? mkDepGraph input++data Direction = Forward | Reverse deriving (Show)+type DependencyTestCase = ([TestDependable], String, Direction, [String])++dependencyTestCases :: [DependencyTestCase]+dependencyTestCases = [ ([TD "first" []], "first", Forward, [])+                      , ([TD "first" []], "first", Reverse, [])++                      , ([TD "first" ["second"], TD "second" []], "first", Forward, ["second"])+                      , ([TD "first" ["second"], TD "second" []], "second", Reverse, ["first"])+                      , ([TD "first" ["second"], TD "second" ["third"], TD "third" []], "first", Forward, ["third", "second"])+                      , ([TD "first" ["second"], TD "second" ["third"], TD "third" [], TD "fourth" ["third"]]+                        , "first", Forward, ["third", "second"])+                      , ([TD "first" [], TD "second" ["first"]]+                        , "first", Reverse, ["second"])+                      , ([TD "first" [], TD "second" ["first"], TD "third" ["second"]]+                        , "first", Reverse, ["third", "second"])+                      , ([TD "first" [], TD "second" ["first"], TD "third" ["second"], TD "fourth" ["second"]]+                        , "first", Reverse, ["fourth", "third", "second"])+                      , ([ TD "first" ["second"], TD "second" ["third"], TD "third" ["fourth"]+                         , TD "second" ["fifth"], TD "fifth" ["third"], TD "fourth" []]+                        , "fourth", Reverse, ["first", "second", "fifth", "third"])+                      , ([ TD "first" ["second"], TD "second" ["third", "fifth"], TD "third" ["fourth"]+                         , TD "fifth" ["third"], TD "fourth" []]+                        , "first", Forward, ["fourth", "third", "fifth", "second"])+                      ]++fromRight :: Either a b -> b+fromRight (Left _) = error "Got a Left value"+fromRight (Right v) = v++mkDependencyTest :: DependencyTestCase -> Test+mkDependencyTest testCase@(deps, a, dir, expected) =+    let f = case dir of+              Forward -> dependencies+              Reverse -> reverseDependencies+    in (show testCase) ~: expected ~=? f (fromRight $ mkDepGraph deps) a++dependencyTests :: [Test]+dependencyTests = map mkDependencyTest dependencyTestCases

@@ -0,0 +1,117 @@+module FilesystemParseTest+    ( tests+    )+where++import Test.HUnit+import Data.Time.Clock ( UTCTime )+import System.FilePath ( (</>) )++import Common++import Database.Schema.Migrations.Migration+import Database.Schema.Migrations.Filesystem+    ( FilesystemStore(..)+    , migrationFromFile+    )++tests :: IO [Test]+tests = migrationParsingTests++-- filename, result+type MigrationParsingTestCase = (FilePath, Either String Migration)++tsStr :: String+tsStr = "2009-04-15 10:02:06 UTC"++ts :: UTCTime+ts = read tsStr++valid_full :: Migration+valid_full = Migration {+               mTimestamp = ts+             , mId = "valid_full"+             , mDesc = Just "A valid full migration."+             , mDeps = ["another_migration"]+             , mApply = "CREATE TABLE test ( a int );"+             , mRevert = Just "DROP TABLE test;"+             }++valid_full_comments :: Migration+valid_full_comments = Migration {+                        mTimestamp = ts+                      , mId = "valid_full"+                      , mDesc = Just "A valid full migration."+                      , mDeps = ["another_migration"]+                      , mApply = "\n-- Comment on a line\nCREATE TABLE test (\n  a int -- comment inline\n);\n"+                      , mRevert = Just "DROP TABLE test;"+                      }++valid_full_colon :: Migration+valid_full_colon = Migration {+                        mTimestamp = ts+                      , mId = "valid_full"+                      , mDesc = Just "A valid full migration."+                      , mDeps = ["another_migration"]+                      , mApply = "\n-- Comment on a line with a colon:\nCREATE TABLE test (\n  a int\n);\n"+                      , mRevert = Just "DROP TABLE test;"+                      }++testStorePath :: FilePath+testStorePath = testFile $ "migration_parsing"++fp :: FilePath -> FilePath+fp = (testStorePath </>)++migrationParsingTestCases :: [MigrationParsingTestCase]+migrationParsingTestCases = [ ("valid_full", Right valid_full)+                            , ("valid_with_comments"+                              , Right (valid_full { mId = "valid_with_comments" }))+                            , ("valid_with_comments2"+                              , Right (valid_full_comments { mId = "valid_with_comments2" }))+                            , ("valid_with_colon"+                              , Right (valid_full_colon { mId = "valid_with_colon" }))+                            , ("valid_with_multiline_deps"+                              , Right (valid_full { mId = "valid_with_multiline_deps"+                                                  , mDeps = ["one", "two", "three"] } ))+                            , ("valid_no_depends"+                              , Right (valid_full { mId = "valid_no_depends", mDeps = [] }))+                            , ("valid_no_desc"+                              , Right (valid_full { mId = "valid_no_desc", mDesc = Nothing }))+                            , ("valid_no_revert"+                              , Right (valid_full { mId = "valid_no_revert", mRevert = Nothing }))+                            , ("invalid_missing_required_fields"+                              , Left $ "Could not parse migration " +++                                         (fp "invalid_missing_required_fields.txt") +++                                         ":Error in " +++                                         (show $ fp "invalid_missing_required_fields.txt") +++                                         ": missing required field(s): " +++                                         "[\"Created\",\"Depends\"]")+                            , ("invalid_field_name"+                              , Left $ "Could not parse migration " +++                                         (fp "invalid_field_name.txt") +++                                         ":Error in " +++                                         (show $ fp "invalid_field_name.txt") +++                                         ": unrecognized field found")+                            , ("invalid_syntax"+                              , Left $ "Could not parse migration " +++                                         (fp "invalid_syntax.txt") +++                                         ":user error (syntax error: line 7, " +++                                         "column 0)")+                            , ("invalid_timestamp"+                              , Left $ "Could not parse migration " +++                                         (fp "invalid_timestamp.txt") +++                                         ":Error in " +++                                         (show $ fp "invalid_timestamp.txt") +++                                         ": unrecognized field found")+                            ]++mkParsingTest :: MigrationParsingTestCase -> IO Test+mkParsingTest (fname, expected) = do+  let store = FSStore { storePath = testStorePath }+  actual <- migrationFromFile store fname+  return $ test $ expected ~=? actual++migrationParsingTests :: IO [Test]+migrationParsingTests =+    sequence $ map mkParsingTest migrationParsingTestCases

@@ -0,0 +1,74 @@+module FilesystemSerializeTest+    ( tests+    )+where++import Test.HUnit+import Data.Time.Clock ( UTCTime )++import Database.Schema.Migrations.Filesystem.Serialize+import Database.Schema.Migrations.Migration++tests :: [Test]+tests = serializationTests++mkSerializationTest :: (Migration, String) -> Test+mkSerializationTest (m, expectedString) = test $ expectedString ~=? serializeMigration m++tsStr :: String+tsStr = "2009-04-15 10:02:06 UTC"++ts :: UTCTime+ts = read tsStr++valid_full :: Migration+valid_full = Migration {+               mTimestamp = ts+             , mId = "valid_full"+             , mDesc = Just "A valid full migration."+             , mDeps = ["another_migration"]+             , mApply = "  CREATE TABLE test (\n    a int\n  );\n"+             , mRevert = Just "DROP TABLE test;"+             }++serializationTestCases :: [(Migration, String)]+serializationTestCases = [ (valid_full, "Description: A valid full migration.\n\+                                        \Created: " ++ tsStr ++ "\n\+                                        \Depends: another_migration\n\+                                        \Apply: |\n\+                                        \  CREATE TABLE test (\n\+                                        \    a int\n\+                                        \  );\n\n\+                                        \Revert: |\n\+                                        \  DROP TABLE test;\n")+                         , (valid_full { mDesc = Nothing }+                           , "Created: " ++ tsStr ++ "\n\+                             \Depends: another_migration\n\+                             \Apply: |\n\+                             \  CREATE TABLE test (\n\+                             \    a int\n\+                             \  );\n\n\+                             \Revert: |\n\+                             \  DROP TABLE test;\n")+                         , (valid_full { mDeps = ["one", "two"] }+                           , "Description: A valid full migration.\n\+                             \Created: " ++ tsStr ++ "\n\+                             \Depends: one two\n\+                             \Apply: |\n\+                             \  CREATE TABLE test (\n\+                             \    a int\n\+                             \  );\n\n\+                             \Revert: |\n\+                             \  DROP TABLE test;\n")+                         , (valid_full { mRevert = Nothing }+                           , "Description: A valid full migration.\n\+                             \Created: " ++ tsStr ++ "\n\+                             \Depends: another_migration\n\+                             \Apply: |\n\+                             \  CREATE TABLE test (\n\+                             \    a int\n\+                             \  );\n")+                         ]++serializationTests :: [Test]+serializationTests = map mkSerializationTest serializationTestCases

@@ -0,0 +1,33 @@+module FilesystemTest+    ( tests+    )+where++import Database.Schema.Migrations.Filesystem+import Database.Schema.Migrations.Store ( MigrationStore(..) )++import Test.HUnit+import qualified Data.Set as Set+import Common++tests :: IO [Test]+tests = sequence [getMigrationsTest]++getMigrationsTest :: IO Test+getMigrationsTest = do+  let store = FSStore { storePath = testFile "migration_parsing" }+      expected = Set.fromList [ "invalid_field_name"+                              , "invalid_missing_required_fields"+                              , "invalid_syntax"+                              , "invalid_timestamp"+                              , "valid_full"+                              , "valid_no_depends"+                              , "valid_no_desc"+                              , "valid_no_revert"+                              , "valid_with_comments"+                              , "valid_with_comments2"+                              , "valid_with_colon"+                              , "valid_with_multiline_deps"+                              ]+  migrations <- getMigrations store+  return $ expected ~=? Set.fromList migrations

@@ -0,0 +1,72 @@+{-# LANGUAGE TypeSynonymInstances,GeneralizedNewtypeDeriving,MultiParamTypeClasses,FlexibleInstances #-}+module MigrationsTest+    ( tests+    )+where++import Test.HUnit+import Control.Monad.Identity ( runIdentity, Identity )+import qualified Data.Map as Map+import Data.Time.Clock ( UTCTime )++import Database.Schema.Migrations+import Database.Schema.Migrations.Store+import Database.Schema.Migrations.Migration+import Database.Schema.Migrations.Backend++tests :: [Test]+tests = migrationsToApplyTests++type TestBackend = [Migration]++newtype TestM a = TestM (Identity a) deriving (Monad)++instance MonadMigration TestM where+    getCurrentTime = undefined++instance Backend TestBackend TestM where+    getBootstrapMigration _ = undefined+    isBootstrapped _ = return True+    applyMigration _ _ = undefined+    revertMigration _ _ = undefined+    getMigrations b = return $ map mId b++-- |Given a backend and a store, what are the list of migrations+-- missing in the backend that are available in the store?+type MissingMigrationTestCase = (MigrationMap, TestBackend, Migration,+                                 [Migration])++ts :: UTCTime+ts = read "2009-04-15 10:02:06 UTC"++blankMigration :: Migration+blankMigration = Migration { mTimestamp = ts+                           , mId = undefined+                           , mDesc = Nothing+                           , mApply = ""+                           , mRevert = Nothing+                           , mDeps = []+                           }++missingMigrationsTestcases :: [MissingMigrationTestCase]+missingMigrationsTestcases =  [ (m, [], one, [one])+                              , (m, [one], one, [])+                              , (m, [one], two, [two])+                              , (m, [one, two], one, [])+                              , (m, [one, two], two, [])+                              ]+    where+      one = blankMigration { mId = "one" }+      two = blankMigration { mId = "two", mDeps = ["one"] }+      m = Map.fromList [ (mId e, e) | e <- [one, two] ]++mkTest :: MissingMigrationTestCase -> Test+mkTest (mapping, backend, theMigration, expected) =+  let Right graph = depGraphFromMapping mapping+      storeData = StoreData mapping graph+      TestM act = migrationsToApply storeData backend theMigration+      result = runIdentity act+  in expected ~=? result++migrationsToApplyTests :: [Test]+migrationsToApplyTests = map mkTest missingMigrationsTestcases

@@ -0,0 +1,118 @@+module StoreTest+    ( tests+    )+where++import Test.HUnit+import qualified Data.Map as Map++import Database.Schema.Migrations.Migration+import Database.Schema.Migrations.Store++tests :: [Test]+tests = validateSingleMigrationTests+        ++ validateMigrationMapTests++type ValidateSingleTestCase = ( MigrationMap+                              , Migration+                              , [MapValidationError]+                              )++type ValidateMigrationMapTestCase = ( MigrationMap+                                    , [MapValidationError]+                                    )++emptyMap :: MigrationMap+emptyMap = Map.fromList []++partialMap :: MigrationMap+partialMap = Map.fromList [ ("one", undefined)+                          , ("three", undefined)+                          ]++fullMap :: MigrationMap+fullMap = Map.fromList [ ("one", undefined)+                       , ("two", undefined)+                       , ("three", undefined)+                       ]++withDeps :: Migration+withDeps = Migration { mTimestamp = undefined+                     , mId = "with_deps"+                     , mDesc = Just "with dependencies"+                     , mApply = ""+                     , mRevert = Nothing+                     , mDeps = ["one", "two", "three"]+                     }++noDeps :: Migration+noDeps = Migration { mTimestamp = undefined+                   , mId = "no_deps"+                   , mDesc = Just "no dependencies"+                   , mApply = ""+                   , mRevert = Nothing+                   , mDeps = []+                   }++validateSingleTestCases :: [ValidateSingleTestCase]+validateSingleTestCases = [ (emptyMap, withDeps, [ DependencyReferenceError (mId withDeps) "one"+                                                 , DependencyReferenceError (mId withDeps) "two"+                                                 , DependencyReferenceError (mId withDeps) "three"+                                                 ]+                            )+                          , (emptyMap, noDeps, [])+                          , (partialMap, withDeps, [DependencyReferenceError (mId withDeps) "two"])+                          , (fullMap, withDeps, [])+                          , (fullMap, noDeps, [])+                          ]++validateSingleMigrationTests :: [Test]+validateSingleMigrationTests =+    map mkValidateSingleTest validateSingleTestCases+        where+          mkValidateSingleTest (mmap, m, errs) =+              errs ~=? validateSingleMigration mmap m++m1 :: Migration+m1 = noDeps { mId = "m1"+            , mDeps = [] }++m2 :: Migration+m2 = noDeps { mId = "m2"+            , mDeps = ["m1"] }++m3 :: Migration+m3 = noDeps { mId = "m3"+            , mDeps = ["nonexistent"] }++m4 :: Migration+m4 = noDeps { mId = "m4"+            , mDeps = ["one", "two"] }++map1 :: MigrationMap+map1 = Map.fromList [ ("m1", m1)+                    , ("m2", m2)+                    ]++map2 :: MigrationMap+map2 = Map.fromList [ ("m3", m3)+                    ]++map3 :: MigrationMap+map3 = Map.fromList [ ("m4", m4)+                    ]++validateMapTestCases :: [ValidateMigrationMapTestCase]+validateMapTestCases = [ (emptyMap, [])+                       , (map1, [])+                       , (map2, [DependencyReferenceError (mId m3) "nonexistent"])+                       , (map3, [ DependencyReferenceError (mId m4) "one"+                                , DependencyReferenceError (mId m4) "two"])+                       ]++validateMigrationMapTests :: [Test]+validateMigrationMapTests =+    map mkValidateMapTest validateMapTestCases+        where+          mkValidateMapTest (mmap, errs) =+              errs ~=? validateMigrationMap mmap

@@ -0,0 +1,10 @@+Description: The first migration in the store.+Created: 2009-04-15 10:02:06 UTC+Depends:+Apply:++  CREATE TABLE test (a int);++Revert:++  DROP TABLE test;

@@ -0,0 +1,10 @@+Description: Add another meaningless column to test.+Created: 2009-04-15 10:04:31 UTC+Depends: root+Apply:++  ALTER TABLE test ADD b int;++Revert:++  ALTER TABLE test DROP COLUMN b;

@@ -0,0 +1,10 @@+Description: Add a constraint on test.b.+Created: 2009-04-15 11:36:49 UTC+Depends: update1+Apply:++  CREATE UNIQUE INDEX test_b_idx ON test(b);++Revert:++  DROP INDEX test_b_idx;

@@ -0,0 +1,11 @@+Description: The first migration in the store.+InvalidField: bogus+Created: 2009-04-15 10:02:06 UTC+Depends: valid+Apply:++  CREATE TABLE test (a int);++Revert:++  DROP TABLE test;

@@ -0,0 +1,8 @@+Description: A valid full migration.+Apply:++  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;

@@ -0,0 +1,9 @@+Description: The first migration in the store.+Created: 2009-04-15 10:02:06 UTC+Depends: valid+Apply:+CREATE TABLE test (a int);++Revert:++  DROP TABLE test;

@@ -0,0 +1,10 @@+Description: The first migration in the store.+Created: 209-41-15 :02:06 UTC+Depends: valid+Apply:++  CREATE TABLE test (a int);++Revert:++  DROP TABLE test;

@@ -0,0 +1,10 @@+Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC+Depends: another_migration+Apply:++  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;

@@ -0,0 +1,10 @@+Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC+Depends:+Apply:++  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;

@@ -0,0 +1,9 @@+Created: 2009-04-15 10:02:06 UTC+Depends: another_migration+Apply:++  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;

@@ -0,0 +1,8 @@+Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC+Depends: another_migration+Apply:++  CREATE TABLE test (+    a int+  );

@@ -0,0 +1,11 @@+Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC+Depends: another_migration+Apply: |++  -- Comment on a line with a colon:+  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;

@@ -0,0 +1,13 @@+# This is a test migration.  It includes all fields with valid values+# and takes advantage of most parser corner-cases and features.++Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC+Depends: another_migration+Apply:++  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;

@@ -0,0 +1,11 @@+Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC+Depends: another_migration+Apply: |++  -- Comment on a line+  CREATE TABLE test (+    a int -- comment inline+  );++Revert: DROP TABLE test;

@@ -0,0 +1,15 @@+Description: A valid full migration.+Created: 2009-04-15 10:02:06 UTC++Depends:+  one+  two+  three++Apply:++  CREATE TABLE test (+    a int+  );++Revert: DROP TABLE test;