dbmigrations 0.9.1 → 1.0

raw patch · 15 files changed

+519/−78 lines, 15 filesdep +MissingHPVP ok

version bump matches the API change (PVP)

Dependencies added: MissingH

API changes (from Hackage documentation)

Files

• MOO.TXT +41/−6
• dbmigrations.cabal +8/−2
• src/Database/Schema/Migrations/Filesystem.hs +2/−2
• src/Database/Schema/Migrations/Migration.hs +13/−5
• src/Database/Schema/Migrations/Store.hs +8/−0
• src/Moo/CommandHandlers.hs +22/−16
• src/Moo/CommandUtils.hs +42/−1
• src/Moo/Core.hs +127/−45
• src/Moo/Main.hs +4/−0
• test/Common.hs +14/−0
• test/ConfigurationTest.hs +104/−0
• test/FilesystemParseTest.hs +1/−1
• test/InMemoryStore.hs +32/−0
• test/LinearMigrationsTest.hs +95/−0
• test/TestDriver.hs +6/−0

@@ -6,7 +6,8 @@ "moo", is responsible for creating, installing, and reverting migrations in your database backend. -At present, PostgreSQL and Sqlite3 are the only supported database backends.+At present, PostgreSQL and Sqlite3 are the only supported database+backends.  The moo tool works by creating migration files in a specific location, called a migration store, on your filesystem. This directory is where@@ -126,7 +127,19 @@   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)+  DBM_TIMESTAMP_FILENAMES = on/off (or true/false; defaults to off) +Alternatively, you may save your settings to "moo.cfg" file in the current+directory (probably a project root) and moo will load it automatically, if+present. Specifying --config-file disables this behavior.++If you use a config file (either the default one or the one specified with+--config-file option) but the environment variables are set, they will+override settings from the file. You may use this to have project settings+specified in a file and use environment to specify user-local configuration+options.+ Migration file format --------------------- @@ -177,7 +190,8 @@ Environment ----------- -Moo depends on these environment variables:+Moo depends on these environment variables / configuration file+settings:    DBM_DATABASE_TYPE @@ -211,15 +225,25 @@     schema.  Initially, you'll probably set this to an extant (but     empty) directory.  moo will not create it for you. +  DBM_LINEAR_MIGRATIONS++    If set to true/on, the linear migrations feature will be enabled.+    Defaults to off. See 'Linear migrations' section for more details.++  DBM_TIMESTAMP_FILENAMES++    If set to true/on, the migration filename for new migrations will+    have a timestamp embedded in it.+ Commands --------    new <migration name>: create a new migration with the given name and     save it in the migration store.  This command will prompt you for-    dependencies on other migrations and ask for confirmation before-    creating the migration in the store.  If you use the --no-ask-    flag, the migration will be created immediately with no-    dependencies.+    dependencies on other migrations (if the 'linear migrations'+    feature is disabled) and ask for confirmation before creating the+    migration in the store.  If you use the --no-ask flag, the migration+    will be created immediately with no dependencies.    apply <migration name>: apply the specified migration (and its     dependencies) to the database.  This operation will be performed@@ -257,3 +281,14 @@     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.++Linear migrations+-----------------++If you know that every migration needs to depend on all previous ones,+consider enabling this feature. When enabled, 'moo new' will automatically+select smallest subset of existing migrations that will make the new one+indirectly depend on every other already in the store. This in turn makes+the store linear-ish (in terms of order of execution) and helps managing the+migrations by always depending on previous work. Also, this may easily be used+to see how the database changed in time.

@@ -1,5 +1,5 @@ Name:                dbmigrations-Version:             0.9.1+Version:             1.0 Synopsis:            An implementation of relational database "migrations" Description:         A library and program for the creation,                      management, and installation of schema updates@@ -108,11 +108,14 @@     template-haskell,     yaml-light >= 0.1,     bytestring >= 0.9,+    MissingH,     HDBC >= 2.2.1,     HDBC-postgresql,     HDBC-sqlite3,     HUnit >= 1.2,-    process >= 1.1+    process >= 1.1,+    configurator >= 0.2,+    text >= 0.11    other-modules:     BackendTest@@ -126,6 +129,9 @@     MigrationsTest     StoreTest     TestDriver+    InMemoryStore+    LinearMigrationsTest+    ConfigurationTest    if impl(ghc >= 6.12.0)     ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields

@@ -29,7 +29,7 @@  import Database.Schema.Migrations.Migration     ( Migration(..)-    , newMigration+    , emptyMigration     ) import Database.Schema.Migrations.Filesystem.Serialize import Database.Schema.Migrations.Store@@ -98,7 +98,7 @@        case length missing of         0 -> do-          let newM = newMigration name+          let newM = emptyMigration name           case migrationFromFields newM fields of             Nothing -> throwFS $ "Error in " ++ (show path) ++ ": unrecognized field found"             Just m -> return m

@@ -1,6 +1,7 @@ module Database.Schema.Migrations.Migration     ( Migration(..)     , newMigration+    , emptyMigration     ) where @@ -22,12 +23,19 @@     depsOf = mDeps     depId = mId -newMigration :: String -> Migration-newMigration theId =+emptyMigration :: String -> Migration+emptyMigration name =   Migration { mTimestamp = Nothing-            , mId = theId-            , mApply = "(Apply SQL here.)"+            , mId = name+            , mApply = ""             , mRevert = Nothing-            , mDesc = Just "(Describe migration here.)"+            , mDesc = Nothing             , mDeps = []             }++newMigration :: String -> Migration+newMigration theId = +  (emptyMigration theId) +    { mApply = "(Apply SQL here.)"+    , mDesc = Just "(Describe migration here.)"+    }

@@ -19,6 +19,7 @@     , depGraphFromMapping     , validateMigrationMap     , validateSingleMigration+    , leafMigrations     ) where @@ -26,6 +27,7 @@ import Control.Monad ( mzero ) import Control.Applicative ( (<$>) ) import qualified Data.Map as Map+import Data.Graph.Inductive.Graph ( labNodes, indeg )  import Database.Schema.Migrations.Migration     ( Migration(..)@@ -148,3 +150,9 @@ -- won't want to use this directly; use 'loadMigrations' instead. depGraphFromMapping :: MigrationMap -> Either String (DependencyGraph Migration) depGraphFromMapping mapping = mkDepGraph $ Map.elems mapping++-- |Finds migrations that no other migration depends on (effectively finds all+-- vertices with in-degree equal to zero).+leafMigrations :: StoreData -> [String]+leafMigrations s = [l | (n, l) <- labNodes g, indeg g n == 0]+    where g = depGraph $ storeDataGraph s

@@ -20,25 +20,31 @@  newCommand :: CommandHandler newCommand storeData = do-  required <- asks _appRequiredArgs-  store    <- asks _appStore-  let [migrationId] = required+  required   <- asks _appRequiredArgs+  store      <- asks _appStore+  linear     <- asks _appLinearMigrations+  timestamp  <- asks _appTimestampFilenames+  timeString <- (++"_") <$> liftIO getCurrentTimestamp++  let [migrationId] = if timestamp+      then fmap (timeString++) required+      else required   noAsk <- _noAsk <$> asks _appOptions    liftIO $ do     fullPath <- fullMigrationName store migrationId-     when (isJust $ storeLookup storeData migrationId) $          do            putStrLn $ "Migration " ++ (show fullPath) ++ " already exists"            exitWith (ExitFailure 1) -    -- Default behavior: ask for dependencies-    deps <- if noAsk then (return []) else-            do-              putStrLn $ "Selecting dependencies for new \-                         \migration: " ++ migrationId-              interactiveAskDeps storeData+    -- Default behavior: ask for dependencies if linear mode is disabled+    deps <- if linear then (return $ leafMigrations storeData) else+           if noAsk then (return []) else+           do+             putStrLn $ "Selecting dependencies for new \+                        \migration: " ++ migrationId+             interactiveAskDeps storeData      result <- if noAsk then (return True) else               (confirmCreation migrationId deps)@@ -47,14 +53,14 @@       True -> do                now <- Clock.getCurrentTime                status <- createNewMigration store $ (newMigration migrationId) { mDeps = deps-                                                                               , mTimestamp = Just now-                                                                               }+                                                    , mTimestamp = Just now+                                                    }                case status of-                 Left e -> putStrLn e >> (exitWith (ExitFailure 1))-                 Right _ -> putStrLn $ "Migration created successfully: " ++-                            show fullPath+                    Left e -> putStrLn e >> (exitWith (ExitFailure 1))+                    Right _ -> putStrLn $ "Migration created successfully: " +++                               show fullPath       False -> do-               putStrLn "Migration creation cancelled."+              putStrLn "Migration creation cancelled."  upgradeCommand :: CommandHandler upgradeCommand storeData = do

@@ -7,13 +7,15 @@        , revert        , withBackend        , makeBackend+       , getCurrentTimestamp        ) where  import Control.Exception ( bracket ) import Control.Monad ( when, forM_, unless ) import Control.Monad.Reader ( asks ) import Control.Monad.Trans ( liftIO )-import Data.List ( intercalate, sortBy )+import Data.List ( intercalate, sortBy, isPrefixOf )+import Data.Time.Clock (getCurrentTime) import Data.Maybe ( fromJust, isJust ) import System.Exit ( exitWith, ExitCode(..) ) import System.IO ( stdout, hFlush, hGetBuffering@@ -28,6 +30,10 @@                                         ) import Moo.Core +getCurrentTimestamp :: IO String+getCurrentTimestamp =+  replace ":" "-" . replace " " "_" . take 19 . show <$> getCurrentTime+ apply :: Migration -> StoreData -> Backend -> Bool -> IO [Migration] apply m storeData backend complain = do   -- Get the list of migrations to apply@@ -217,3 +223,38 @@                  , ('d', (Done, Just "done, do not ask me about more dependencies"))                  , ('q', (Quit, Just "cancel this operation and quit"))                  ]++-- The following code is vendored from MissingH Data.List.Utils:++{- | Similar to Data.List.span, but performs the test on the entire remaining+list instead of just one element.++@spanList p xs@ is the same as @(takeWhileList p xs, dropWhileList p xs)@+-}+spanList :: ([a] -> Bool) -> [a] -> ([a], [a])++spanList _ [] = ([],[])+spanList func list@(x:xs) =+    if func list+       then (x:ys,zs)+       else ([],list)+    where (ys,zs) = spanList func xs++{- | Similar to Data.List.break, but performs the test on the entire remaining+list instead of just one element.+-}+breakList :: ([a] -> Bool) -> [a] -> ([a], [a])+breakList func = spanList (not . func)++replace :: Eq a => [a] -> [a] -> [a] -> [a]+replace old new = intercalate new . split old++split :: Eq a => [a] -> [a] -> [[a]]+split _ [] = []+split delim str =+  let (firstline, remainder) = breakList (isPrefixOf delim) str+   in firstline : case remainder of+                       [] -> []+                       x -> if x == delim+                               then [[]]+                               else split delim (drop (length delim) x)

@@ -1,15 +1,31 @@ {-# LANGUAGE ExistentialQuantification #-}-module Moo.Core where+module Moo.Core+    ( AppT+    , CommandHandler+    , CommandOptions (..)+    , Command (..)+    , AppState (..)+    , Configuration (..)+    , DbConnDescriptor (..)+    , databaseTypes+    , envDatabaseName+    , envDatabaseType+    , envLinearMigrations+    , envStoreName+    , loadConfiguration) where  import Control.Applicative ((<$>), (<*>)) import Control.Monad.Reader (ReaderT) import qualified Data.Configurator as C-import Data.Configurator.Types (Config)+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 (isJust, fromMaybe) + import Database.Schema.Migrations () import Database.Schema.Migrations.Store (MigrationStore, StoreData) import Database.Schema.Migrations.Backend@@ -22,14 +38,16 @@ 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+data AppState = AppState { _appOptions          :: CommandOptions+                         , _appCommand          :: Command+                         , _appRequiredArgs     :: [String]+                         , _appOptionalArgs     :: [String]+                         , _appStore            :: MigrationStore+                         , _appDatabaseConnStr  :: DbConnDescriptor+                         , _appDatabaseType     :: String+                         , _appStoreData        :: StoreData+                         , _appLinearMigrations :: Bool+                         , _appTimestampFilenames :: Bool                          }  type ShellEnvironment = [(String, String)]@@ -38,42 +56,106 @@     { _connectionString   :: String     , _databaseType       :: String     , _migrationStorePath :: FilePath-    }+    , _linearMigrations   :: Bool+    , _timestampFilenames :: Bool+    } deriving Show -loadConfiguration :: Maybe FilePath -> IO (Either String Configuration)-loadConfiguration pth = do-    mCfg <- case pth of-        Nothing -> fromShellEnvironment <$> getEnvironment-        Just path -> fromConfigurator =<< C.load [C.Required path]+-- |Intermediate type used during config loading.+data LoadConfig = LoadConfig+    { _lcConnectionString   :: Maybe String+    , _lcDatabaseType       :: Maybe String+    , _lcMigrationStorePath :: Maybe FilePath+    , _lcLinearMigrations   :: Maybe Bool+    , _lcTimestampFilenames :: Maybe Bool+    } deriving Show -    case mCfg of-        Nothing -> do-            case pth of-                Nothing -> return $ Left "Missing required environment variables"-                Just path -> return $ Left $ "Could not load configuration from " ++ path-        Just cfg -> return $ Right cfg+defConfigFile :: String+defConfigFile = "moo.cfg" -fromShellEnvironment :: ShellEnvironment -> Maybe Configuration-fromShellEnvironment env = Configuration <$> connectionString-                                         <*> databaseType-                                         <*> migrationStorePath+newLoadConfig :: LoadConfig+newLoadConfig = LoadConfig Nothing Nothing Nothing Nothing Nothing++isValidConfig :: LoadConfig -> Bool+isValidConfig (LoadConfig a b c _ _) = all isJust [a, b, c]++loadConfigToConfig :: LoadConfig -> Configuration+loadConfigToConfig (LoadConfig (Just cs) (Just dt) (Just msp) lm ts) =+  Configuration cs dt msp+    (fromMaybe False lm)+    (fromMaybe False ts)+loadConfigToConfig _ = error "LoadConfig is invalid!"++-- |Setters for fields of 'LoadConfig'.+lcConnectionString, lcDatabaseType, 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+lcLinearMigrations c v   = c { _lcLinearMigrations   = v }+lcTimestampFilenames c v = c { _lcTimestampFilenames = v }+++-- | @f .= v@ invokes f only if v is 'Just'+(.=) :: (Monad m) => (a -> Maybe b -> a) -> m (Maybe b) -> m (a -> a)+(.=) f v' = do+    v <- v'+    return $ case v of+      Just _ -> flip f v+      _      -> id++-- |It's just @flip '<*>'@+(&) :: (Applicative m) => m a -> m (a -> b) -> m b+(&) = flip (<*>)++infixr 3 .=+infixl 2 &++applyEnvironment :: ShellEnvironment -> LoadConfig -> IO LoadConfig+applyEnvironment env lc =+    return lc & lcConnectionString   .= f envDatabaseName+              & lcDatabaseType       .= f envDatabaseType+              & lcMigrationStorePath .= f envStoreName+              & lcLinearMigrations   .= readFlag <$> f envLinearMigrations+    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     where-      connectionString = envLookup envDatabaseName-      databaseType = envLookup envDatabaseType-      migrationStorePath = envLookup envStoreName-      envLookup = (\evar -> lookup evar env)+        f :: Configured a => String -> IO (Maybe a)+        f = C.lookup cfg . T.pack -fromConfigurator :: Config -> IO (Maybe Configuration)-fromConfigurator conf = do-    let configLookup = C.lookup conf . T.pack-    connectionString <- configLookup envDatabaseName-    databaseType <- configLookup envDatabaseType-    migrationStorePath <- configLookup envStoreName+-- |Loads config file (falling back to default one if not specified) and then+-- overrides configuration with an environment.+loadConfiguration :: Maybe FilePath -> IO (Either String Configuration)+loadConfiguration pth = do+    file <- maybe (C.load [C.Optional defConfigFile])+                  (\p -> C.load [C.Required p]) pth+    env <- getEnvironment+    cfg <- applyConfigFile file newLoadConfig >>= applyEnvironment env -    return $ Configuration <$> connectionString-                           <*> databaseType-                           <*> migrationStorePath+    if isValidConfig cfg+       then return $ Right $ loadConfigToConfig cfg+       else return $ Left "Configuration is invalid, check if everything is set." +-- |Converts @Just "on"@ and @Just "true"@ (case insensitive) to @True@,+-- anything else to @False@.+readFlag :: Maybe String -> Maybe Bool+readFlag Nothing  = Nothing+readFlag (Just v) = go $ map toLower v+    where+        go "on"    = Just True+        go "true"  = Just True+        go "off"   = Just False+        go "false" = Just False+        go _       = Nothing+ -- |CommandOptions are those options that can be specified at the command -- prompt to modify the behavior of a command. data CommandOptions = CommandOptions { _configFilePath :: Maybe String@@ -91,12 +173,6 @@                        , _cHandler        :: CommandHandler                        } --- |ConfigOptions are those options read from configuration file-data ConfigData = ConfigData { _dbTypeStr     :: String-                             , _dbConnStr     :: String-                             , _fileStorePath :: String-                             }- newtype DbConnDescriptor = DbConnDescriptor String  -- |The values of DBM_DATABASE_TYPE and their corresponding connection@@ -114,3 +190,9 @@  envStoreName :: String envStoreName = "DBM_MIGRATION_STORE"++envLinearMigrations :: String+envLinearMigrations = "DBM_LINEAR_MIGRATIONS"++envTimestampFilenames :: String+envTimestampFilenames = "DBM_TIMESTAMP_FILENAMES"

@@ -32,6 +32,7 @@   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:"   forM_ commands $ \command -> do           putStrLn $ "  " ++ usageString command@@ -67,6 +68,7 @@       dbType = _databaseType conf       storePathStr = _migrationStorePath conf       store = filesystemStore $ FSStore { storePath = storePathStr }+      linear = _linearMigrations conf    if length required < length ( _cRequired command) then       usageSpecific command else@@ -85,6 +87,8 @@                               , _appDatabaseType = dbType                               , _appStore = store                               , _appStoreData = storeData+                              , _appLinearMigrations = linear+                              , _appTimestampFilenames = _timestampFilenames conf                               }             runReaderT (_cHandler command storeData) st `catchSql` reportSqlError 

@@ -3,12 +3,15 @@     ( TestDependable(..)     , repoRoot     , testFile+    , satisfies+    , (.&&.)     ) where  import CommonTH import System.FilePath ( (</>) ) import Language.Haskell.TH.Syntax (lift)+import Test.HUnit  import Database.Schema.Migrations.Dependencies ( Dependable(..) ) @@ -26,3 +29,14 @@                          , tdDeps :: [String]                          }                       deriving (Show, Eq, Ord)+++satisfies :: String -> a -> (a -> Bool) -> IO Test+satisfies m v f = return $ TestCase $ assertBool m (f v)++(.&&.) :: Test -> Test -> Test+(TestList xs) .&&. (TestList ys) = TestList (xs ++ ys)+(TestList xs) .&&. y = TestList (xs ++ [y])+x .&&. (TestList ys) = TestList (x:ys)+a .&&. b = TestList [a, b]+infixl 0 .&&.

@@ -0,0 +1,104 @@+module ConfigurationTest (tests) where++import           Control.Exception  (SomeException, try)+import           Data.Either        (isLeft, isRight)+import           System.Directory+import           System.Environment (setEnv, unsetEnv)+import           Test.HUnit++import           Common+import           Moo.Core++tests :: IO [Test]+tests = sequence [prepareTestEnv >> e | e <- entries]+    where entries = [ loadsConfigFile+                    , loadsPropertiesFromFile+                    , loadsDefaultConfigFile+                    , environmentOverridesProperties+                    , ifNoConfigFileIsAvailableEnvironmentIsUsed+                    , throwsWhenConfigFileIsInvalid+                    , returnsErrorWhenNotAllPropertiesAreSet+                    , canReadTimestampsConfig+                    ]++prepareTestEnv :: IO ()+prepareTestEnv = do+    setCurrentDirectory $ testFile "config_loading"+    unsetEnv "DBM_DATABASE_TYPE"+    unsetEnv "DBM_DATABASE"+    unsetEnv "DBM_MIGRATION_STORE"+    unsetEnv "DBM_LINEAR_MIGRATIONS"+    unsetEnv "DBM_TIMESTAMP_FILENAMES"++canReadTimestampsConfig :: IO Test+canReadTimestampsConfig = do+  Right cfg <- loadConfiguration (Just "cfg_ts.cfg")+  satisfies "Timestamp not set" cfg _timestampFilenames++loadsConfigFile :: IO Test+loadsConfigFile = do+    cfg' <- loadConfiguration (Just "cfg1.cfg")+    satisfies "File not loaded" cfg' isRight++loadsPropertiesFromFile :: IO Test+loadsPropertiesFromFile = do+    Right cfg <- loadConfiguration (Just "cfg1.cfg")+    return+        (+        _connectionString   cfg ~?= "connection" .&&.+        _databaseType       cfg ~?= "dbtype"     .&&.+        _migrationStorePath cfg ~?= "store"      .&&.+        _linearMigrations   cfg ~?= True+        )++loadsDefaultConfigFile :: IO Test+loadsDefaultConfigFile = do+    Right cfg <- loadConfiguration Nothing+    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"+    Right cfg <- loadConfiguration (Just "cfg1.cfg")+    return+        (+        _connectionString   cfg ~?= "envconn"  .&&.+        _databaseType       cfg ~?= "envdb"    .&&.+        _migrationStorePath cfg ~?= "envstore" .&&.+        _linearMigrations   cfg ~?= False+        )++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"+    Right cfg <- loadConfiguration Nothing+    return+        (+        _connectionString   cfg ~?= "envconn"  .&&.+        _databaseType       cfg ~?= "envdb"    .&&.+        _migrationStorePath cfg ~?= "envstore" .&&.+        _linearMigrations   cfg ~?= False+        )++returnsErrorWhenNotAllPropertiesAreSet :: IO Test+returnsErrorWhenNotAllPropertiesAreSet = do+    cfg <- loadConfiguration (Just "missing.cfg")+    satisfies "Should return error" cfg isLeft++throwsWhenConfigFileIsInvalid :: IO Test+throwsWhenConfigFileIsInvalid = do+    c <- try $ loadConfiguration (Just "invalid.cfg")+    satisfies "Should throw" c (isLeft :: Either SomeException a -> Bool)

@@ -116,4 +116,4 @@  migrationParsingTests :: IO [Test] migrationParsingTests =-    sequence $ map mkParsingTest migrationParsingTestCases+    traverse mkParsingTest migrationParsingTestCases

@@ -0,0 +1,32 @@+module InMemoryStore (inMemoryStore) where++import           Control.Concurrent.MVar+import           Database.Schema.Migrations.Migration+import           Database.Schema.Migrations.Store++type InMemoryData = [(String, Migration)]++-- |Builds simple in-memory store that uses 'MVar' to preserve a list of+-- migrations.+inMemoryStore :: IO MigrationStore+inMemoryStore = do+    store <- newMVar []+    return MigrationStore {+      loadMigration = loadMigrationInMem store+    , saveMigration = saveMigrationInMem store+    , getMigrations = getMigrationsInMem store+    , fullMigrationName = return+    }++loadMigrationInMem :: MVar InMemoryData -> String -> IO (Either String Migration)+loadMigrationInMem store migId = withMVar store $ \migrations -> do+    let mig = lookup migId migrations+    return $ case mig of+        Just m -> Right m+        _      -> Left "Migration not found"++saveMigrationInMem :: MVar InMemoryData -> Migration -> IO ()+saveMigrationInMem store m = modifyMVar_ store $ return . ((mId m, m):)++getMigrationsInMem :: MVar InMemoryData -> IO [String]+getMigrationsInMem store = withMVar store $ return . fmap fst

@@ -0,0 +1,95 @@+module LinearMigrationsTest (tests) where++import           InMemoryStore+import           Test.HUnit++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+import           Moo.Core++tests :: IO [Test]+tests = sequence [ addsMigration+                 , selectsLatestMigrationAsDep+                 , selectsOnlyLeavesAsDeps+                 , doesNotAddDependencyWhenLinearMigrationsAreDisabled+                 ]++addsMigration :: IO Test+addsMigration = do+    state <- prepareState "first"+    mig <- addTestMigration state+    satisfies "Migration not added" mig isRight++selectsLatestMigrationAsDep :: IO Test+selectsLatestMigrationAsDep = do+    state1 <- prepareState "first"+    _ <- addTestMigration state1+    state2 <- prepareStateWith state1 "second"+    Right mig <- addTestMigration state2+    return $ ["first"] ~=? mDeps mig++selectsOnlyLeavesAsDeps :: IO Test+selectsOnlyLeavesAsDeps = do+    state1 <- prepareNormalState "first"+    addTestMigrationWithDeps state1 []+    state2 <- prepareStateWith state1 "second"+    addTestMigrationWithDeps state2 ["first"]+    state3 <- prepareStateWith state2 "third"+    addTestMigrationWithDeps state3 ["first"]+    state4' <- prepareStateWith state3 "fourth"+    let state4 = state4' { _appLinearMigrations = True }+    Right mig <- addTestMigration state4+    return $ ["second", "third"] ~=? mDeps mig++doesNotAddDependencyWhenLinearMigrationsAreDisabled :: IO Test+doesNotAddDependencyWhenLinearMigrationsAreDisabled = do+    state1 <- prepareNormalState "first"+    _ <- addTestMigration state1+    state2 <- prepareStateWith state1 "second"+    Right mig <- addTestMigration state2+    satisfies "Dependencies should be empty" (mDeps mig) null++addTestMigration :: AppState -> IO (Either String Migration)+addTestMigration state = do+    let store = _appStore state+        [migrationId] = _appRequiredArgs state+    runReaderT (newCommand $ _appStoreData state) state+    loadMigration store migrationId++addTestMigrationWithDeps :: AppState -> [String] -> IO ()+addTestMigrationWithDeps state deps = do+    let store = _appStore state+    let [migrationId] = _appRequiredArgs state+    saveMigration store (newMigration migrationId) { mDeps = deps }++prepareState :: String -> IO AppState+prepareState m = do+    store <- inMemoryStore+    Right storeData <- loadMigrations store+    return AppState {+      _appOptions = CommandOptions Nothing False True+    , _appCommand = undefined -- Not used by newCommand+    , _appRequiredArgs = [m]+    , _appOptionalArgs = []+    , _appStore = store+    , _appDatabaseConnStr = DbConnDescriptor ""+    , _appDatabaseType = "none"+    , _appStoreData = storeData+    , _appLinearMigrations = True+    , _appTimestampFilenames = False+    }++prepareStateWith :: AppState -> String -> IO AppState+prepareStateWith state m = do+    Right storeData <- loadMigrations $ _appStore state+    return state { _appRequiredArgs = [m], _appStoreData = storeData }++prepareNormalState :: String -> IO AppState+prepareNormalState m = do+    state <- prepareState m+    return $ state { _appLinearMigrations = False }

@@ -13,6 +13,8 @@ import qualified FilesystemTest import qualified CycleDetectionTest import qualified StoreTest+import qualified LinearMigrationsTest+import qualified ConfigurationTest  import Control.Monad ( forM ) import Control.Exception ( finally, catch, SomeException )@@ -40,6 +42,10 @@                            return $ "Filesystem Parsing" ~: test fspTests                       , do fsTests <- FilesystemTest.tests                            return $ "Filesystem general" ~: test fsTests+                      , do linTests <- LinearMigrationsTest.tests+                           return $ "Linear migrations" ~: test linTests+                      , do cfgTests <- ConfigurationTest.tests+                           return $ "Configuration tests" ~: test cfgTests                       ]   return $ concat [ backendTests                   , ioTests