dbmigrations 2.0.0 → 2.1.0

raw patch · 26 files changed

+294/−223 lines, 26 filesdep +aesondep +string-conversionsdep +unordered-containersdep −yaml-lightPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, string-conversions, unordered-containers, yaml

Dependencies removed: yaml-light

API changes (from Hackage documentation)

Files

• MOO.TXT +4/−2
• dbmigrations.cabal +12/−11
• src/Database/Schema/Migrations.hs +2/−1
• src/Database/Schema/Migrations/Backend.hs +6/−3
• src/Database/Schema/Migrations/Backend/HDBC.hs +15/−11
• src/Database/Schema/Migrations/Dependencies.hs +13/−11
• src/Database/Schema/Migrations/Filesystem.hs +52/−30
• src/Database/Schema/Migrations/Filesystem/Serialize.hs +23/−17
• src/Database/Schema/Migrations/Migration.hs +9/−7
• src/Database/Schema/Migrations/Store.hs +8/−7
• src/Database/Schema/Migrations/Test/BackendTest.hs +5/−3
• src/Moo/CommandHandlers.hs +14/−12
• src/Moo/CommandUtils.hs +24/−21
• src/Moo/Core.hs +4/−3
• src/Moo/Main.hs +5/−2
• test/Common.hs +4/−2
• test/DependencyTest.hs +4/−1
• test/FilesystemParseTest.hs +11/−10
• test/FilesystemSerializeTest.hs +12/−9
• test/FilesystemTest.hs +1/−0
• test/InMemoryStore.hs +7/−4
• test/LinearMigrationsTest.hs +6/−4
• test/Main.hs +51/−0
• test/MigrationsTest.hs +1/−1
• test/StoreTest.hs +1/−0
• test/TestDriver.hs +0/−51

@@ -74,10 +74,12 @@     Confirm: create migration 'hello-world'       (No dependencies)     Are you sure? (yn): y-    Migration created successfully: ".../hello-world.txt"+    Migration created successfully: ".../hello-world.yml" +   New migration will be stored with .yml extension. Older .txt migrations are supported.+  6. Edit the migration you created. In this case, moo created a file-    $DBM_MIGRATION_STORE/hello_world.txt that looks like this:+    $DBM_MIGRATION_STORE/hello_world.yml that looks like this:        Description: (Description here.)       Created: 2015-02-18 00:50:12.041176 UTC

@@ -1,5 +1,5 @@ Name:                dbmigrations-Version:             2.0.0+Version:             2.1.0 Synopsis:            An implementation of relational database "migrations" Description:         A library and program for the creation,                      management, and installation of schema updates@@ -79,20 +79,25 @@     directory >= 1.0,     fgl >= 5.4,     template-haskell,-    yaml-light >= 0.1,+    yaml,     bytestring >= 0.9,+    string-conversions >= 0.4,     text >= 0.11,     configurator >= 0.2,     split >= 0.2.2,-    HUnit >= 1.2+    HUnit >= 1.2,+    aeson < 2,+    unordered-containers    Hs-Source-Dirs:    src   Exposed-Modules:           Database.Schema.Migrations           Database.Schema.Migrations.Backend           Database.Schema.Migrations.Backend.HDBC+          Database.Schema.Migrations.CycleDetection           Database.Schema.Migrations.Dependencies           Database.Schema.Migrations.Filesystem+          Database.Schema.Migrations.Filesystem.Serialize           Database.Schema.Migrations.Migration           Database.Schema.Migrations.Store           Database.Schema.Migrations.Test.BackendTest@@ -102,10 +107,6 @@           Moo.Core           Moo.Main -  Other-Modules:-          Database.Schema.Migrations.CycleDetection-          Database.Schema.Migrations.Filesystem.Serialize- test-suite dbmigrations-tests   default-language: Haskell2010   type: exitcode-stdio-1.0@@ -119,8 +120,9 @@     directory >= 1.0,     fgl >= 5.4,     template-haskell,-    yaml-light >= 0.1,+    yaml,     bytestring >= 0.9,+    string-conversions >= 0.4,     MissingH,     HDBC >= 2.2.1,     HUnit >= 1.2,@@ -139,7 +141,6 @@     FilesystemTest     MigrationsTest     StoreTest-    TestDriver     InMemoryStore     LinearMigrationsTest     ConfigurationTest@@ -150,8 +151,8 @@   else     ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -  Hs-Source-Dirs:  src,test-  Main-is:         TestDriver.hs+  Hs-Source-Dirs:  test+  Main-is:         Main.hs  Executable moo   default-language: Haskell2010

@@ -9,6 +9,7 @@     ) where +import Data.Text ( Text ) import qualified Data.Set as Set import Data.Maybe ( catMaybes ) @@ -25,7 +26,7 @@ -- |Given a 'B.Backend' and a 'S.MigrationMap', query the backend and -- return a list of migration names which are available in the -- 'S.MigrationMap' but which are not installed in the 'B.Backend'.-missingMigrations :: B.Backend -> S.StoreData -> IO [String]+missingMigrations :: B.Backend -> S.StoreData -> IO [Text] missingMigrations backend storeData = do   let storeMigrationNames = map mId $ S.storeMigrations storeData   backendMigrations <- B.getMigrations backend

@@ -1,16 +1,19 @@+{-# LANGUAGE OverloadedStrings #-} module Database.Schema.Migrations.Backend     ( Backend(..)     , rootMigrationName     ) where +import Data.Text ( Text )+ 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 :: Text rootMigrationName = "root"  -- |A Backend represents a database engine backend such as MySQL or@@ -55,7 +58,7 @@             -- does not supply a revert instruction, this has no effect             -- other than bookkeeping. -            , getMigrations :: IO [String]+            , getMigrations :: IO [Text]             -- ^ Returns a list of installed migration names from the             -- backend. @@ -71,4 +74,4 @@             }  instance Show Backend where-   show _ = show "dbmigrations backend"+   show _ = "dbmigrations backend"

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Database.Schema.Migrations.Backend.HDBC     ( hdbcBackend     )@@ -22,22 +23,25 @@     , newMigration     ) +import Data.Text ( Text )+import Data.String.Conversions ( cs, (<>) )+ import Control.Applicative ( (<$>) ) import Data.Time.Clock (getCurrentTime) -migrationTableName :: String+migrationTableName :: Text migrationTableName = "installed_migrations" -createSql :: String-createSql = "CREATE TABLE " ++ migrationTableName ++ " (migration_id TEXT)"+createSql :: Text+createSql = "CREATE TABLE " <> migrationTableName <> " (migration_id TEXT)" -revertSql :: String-revertSql = "DROP TABLE " ++ migrationTableName+revertSql :: Text+revertSql = "DROP TABLE " <> migrationTableName  -- |General Backend constructor for all HDBC connection implementations. hdbcBackend :: (IConnection conn) => conn -> Backend hdbcBackend conn =-    Backend { isBootstrapped = elem migrationTableName <$> getTables conn+    Backend { isBootstrapped = elem (cs migrationTableName) <$> getTables conn             , getBootstrapMigration =                   do                     ts <- getCurrentTime@@ -49,22 +53,22 @@                         }              , applyMigration = \m -> do-                runRaw conn (mApply m)-                run conn ("INSERT INTO " ++ migrationTableName +++                runRaw conn (cs $ mApply m)+                _ <- run conn (cs $ "INSERT INTO " <> migrationTableName <>                           " (migration_id) VALUES (?)") [toSql $ mId m]                 return ()              , revertMigration = \m -> do                   case mRevert m of                     Nothing -> return ()-                    Just query -> runRaw conn query+                    Just query -> runRaw conn (cs query)                   -- Remove migration from installed_migrations in either case.-                  run conn ("DELETE FROM " ++ migrationTableName +++                  _ <- run conn (cs $ "DELETE FROM " <> migrationTableName <>                             " WHERE migration_id = ?") [toSql $ mId m]                   return ()              , getMigrations = do-                results <- quickQuery' conn ("SELECT migration_id FROM " ++ migrationTableName) []+                results <- quickQuery' conn (cs $ "SELECT migration_id FROM " <> migrationTableName) []                 return $ map (fromSql . head) results              , commitBackend = commit conn

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances, OverloadedStrings #-} -- |This module types and functions for representing a dependency -- graph of arbitrary objects and functions for querying such graphs -- to get dependency and reverse dependency information.@@ -11,7 +11,9 @@     ) where +import Data.Text ( Text ) import Data.Maybe ( fromJust )+import Data.Monoid ( (<>) ) import Data.Graph.Inductive.Graph ( Graph(..), nodes, edges, Node, suc, pre, lab ) import Data.Graph.Inductive.PatriciaTree ( Gr ) @@ -21,9 +23,9 @@ -- and a list of other objects upon which they depend. class (Eq a, Ord a) => Dependable a where     -- |The identifiers of the objects on which @a@ depends.-    depsOf :: a -> [String]+    depsOf :: a -> [Text]     -- |The identifier of a 'Dependable' object.-    depId :: a -> String+    depId :: a -> Text  -- |A 'DependencyGraph' represents a collection of objects together -- with a graph of their dependency relationships.  This is intended@@ -31,14 +33,14 @@ data DependencyGraph a = DG { depGraphObjectMap :: [(a, Int)]                             -- ^ A mapping of 'Dependable' objects to                             -- their graph vertex indices.-                            , depGraphNameMap :: [(String, Int)]+                            , depGraphNameMap :: [(Text, Int)]                             -- ^ A mapping of 'Dependable' object                             -- identifiers to their graph vertex                             -- indices.-                            , depGraph :: Gr String String+                            , depGraph :: Gr Text Text                             -- ^ A directed 'Gr' (graph) of the                             -- 'Dependable' objects' dependency-                            -- relationships, with 'String' vertex and+                            -- relationships, with 'Text' vertex and                             -- edge labels.                             } @@ -65,14 +67,14 @@       n = [ (fromJust $ lookup o ids, depId o) | o <- objects ]       e = [ ( fromJust $ lookup o ids             , fromJust $ lookup d ids-            , depId o ++ " -> " ++ depId d) | o <- objects, d <- depsOf' o ]+            , depId o <> " -> " <> depId d) | o <- objects, d <- depsOf' o ]       depsOf' o = map (\i -> fromJust $ lookup i objMap) $ depsOf o        objMap = map (\o -> (depId o, o)) objects       ids = zip objects [1..]       names = map (\(o,i) -> (depId o, i)) ids -type NextNodesFunc = Gr String String -> Node -> [Node]+type NextNodesFunc = Gr Text Text -> Node -> [Node]  cleanLDups :: (Eq a) => [a] -> [a] cleanLDups [] = []@@ -82,16 +84,16 @@ -- |Given a dependency graph and an ID, return the IDs of objects that -- the object depends on.  IDs are returned with least direct -- dependencies first (i.e., the apply order).-dependencies :: (Dependable d) => DependencyGraph d -> String -> [String]+dependencies :: (Dependable d) => DependencyGraph d -> Text -> [Text] dependencies g m = reverse $ cleanLDups $ dependenciesWith suc g m  -- |Given a dependency graph and an ID, return the IDs of objects that -- depend on it.  IDs are returned with least direct reverse -- dependencies first (i.e., the revert order).-reverseDependencies :: (Dependable d) => DependencyGraph d -> String -> [String]+reverseDependencies :: (Dependable d) => DependencyGraph d -> Text -> [Text] reverseDependencies g m = reverse $ cleanLDups $ dependenciesWith pre g m -dependenciesWith :: (Dependable d) => NextNodesFunc -> DependencyGraph d -> String -> [String]+dependenciesWith :: (Dependable d) => NextNodesFunc -> DependencyGraph d -> Text -> [Text] dependenciesWith nextNodes dg@(DG _ nMap theGraph) name =     let lookupId = fromJust $ lookup name nMap         depNodes = nextNodes theGraph lookupId

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings #-} -- |This module provides a type for interacting with a -- filesystem-backed 'MigrationStore'. module Database.Schema.Migrations.Filesystem@@ -9,12 +9,14 @@     ) where -import Prelude hiding ( catch )+import Prelude  import System.Directory ( getDirectoryContents, doesFileExist )-import System.FilePath ( (</>), takeExtension, dropExtension-                       , takeFileName, takeBaseName )-import Data.ByteString.Char8 ( unpack )+import System.FilePath ( (</>), takeExtension, dropExtension, takeBaseName )+import Data.Text ( Text )+import qualified Data.Text as T+import qualified Data.ByteString.Char8 as BSC+import Data.String.Conversions ( cs, (<>) )  import Data.Typeable ( Typeable ) import Data.Time.Clock ( UTCTime )@@ -23,9 +25,11 @@  import Control.Applicative ( (<$>) ) import Control.Monad ( filterM )-import Control.Exception ( IOException, Exception(..), throw, catch )+import Control.Exception ( Exception(..), throw, catch ) -import Data.Yaml.YamlLight+import Data.Aeson as J (Object, Value(String, Null))+import Data.HashMap.Strict as M (toList)+import Data.Yaml  import Database.Schema.Migrations.Migration     ( Migration(..)@@ -34,7 +38,7 @@ import Database.Schema.Migrations.Filesystem.Serialize import Database.Schema.Migrations.Store -type FieldProcessor = String -> Migration -> Maybe Migration+type FieldProcessor = Text -> Migration -> Maybe Migration  data FilesystemStoreSettings = FSStore { storePath :: FilePath } @@ -47,11 +51,14 @@ throwFS = throw . FilesystemStoreError  filenameExtension :: String-filenameExtension = ".txt"+filenameExtension = ".yml" +filenameExtensionTxt :: String+filenameExtensionTxt = ".txt"+ filesystemStore :: FilesystemStoreSettings -> MigrationStore filesystemStore s =-    MigrationStore { fullMigrationName = fsFullMigrationName s+    MigrationStore { fullMigrationName = fmap addNewMigrationExtension . fsFullMigrationName s                     , loadMigration = \theId -> migrationFromFile s theId @@ -60,37 +67,50 @@                        let migrationFilenames = [ f | f <- contents, isMigrationFilename f ]                            fullPaths = [ (f, storePath s </> f) | f <- migrationFilenames ]                        existing <- filterM (\(_, full) -> doesFileExist full) fullPaths-                       return [ dropExtension short | (short, _) <- existing ]+                       return [ cs $ dropExtension short | (short, _) <- existing ]                     , saveMigration = \m -> do                        filename <- fsFullMigrationName s $ mId m-                       writeFile filename $ serializeMigration m+                       BSC.writeFile (cs $ addNewMigrationExtension filename) $ serializeMigration m                    } -fsFullMigrationName :: FilesystemStoreSettings -> FilePath -> IO FilePath-fsFullMigrationName s name = return $ storePath s </> name ++ filenameExtension+addNewMigrationExtension :: FilePath -> FilePath+addNewMigrationExtension path = path <> filenameExtension -isMigrationFilename :: FilePath -> Bool-isMigrationFilename path = takeExtension path == filenameExtension+addMigrationExtension :: FilePath -> String -> FilePath+addMigrationExtension path ext = path <> ext +-- |Build path to migrations without extension.+fsFullMigrationName :: FilesystemStoreSettings -> Text -> IO FilePath+fsFullMigrationName s name = return $ storePath s </> cs name++isMigrationFilename :: String -> Bool+isMigrationFilename path = (cs $ takeExtension path) `elem` [filenameExtension, filenameExtensionTxt]+ -- |Given a store and migration name, read and parse the associated -- migration and return the migration if successful.  Otherwise return -- a parsing error message.-migrationFromFile :: FilesystemStoreSettings -> String -> IO (Either String Migration)+migrationFromFile :: FilesystemStoreSettings -> Text -> IO (Either String Migration) migrationFromFile store name =-    fsFullMigrationName store name >>= migrationFromPath+    fsFullMigrationName store (cs name) >>= migrationFromPath  -- |Given a filesystem path, read and parse the file as a migration -- return the 'Migration' if successful.  Otherwise return a parsing -- error message. migrationFromPath :: FilePath -> IO (Either String Migration) migrationFromPath path = do-  let name = takeBaseName $ takeFileName path+  let name = cs $ takeBaseName path   (Right <$> process name) `catch` (\(FilesystemStoreError s) -> return $ Left $ "Could not parse migration " ++ path ++ ":" ++ s)    where+    readMigrationFile = do+      ymlExists <- doesFileExist (addNewMigrationExtension path)+      if ymlExists+        then decodeFileThrow (addNewMigrationExtension path) `catch` (\(e::ParseException) -> throwFS $ show e)+        else decodeFileThrow (addMigrationExtension path filenameExtensionTxt) `catch` (\(e::ParseException) -> throwFS $ show e)+     process name = do-      yaml <- parseYamlFile path `catch` (\(e::IOException) -> throwFS $ show e)+      yaml <- readMigrationFile        -- Convert yaml structure into basic key/value map       let fields = getFields yaml@@ -104,14 +124,16 @@             Just m -> return m         _ -> throwFS $ "Error in " ++ (show path) ++ ": missing required field(s): " ++ (show missing) -getFields :: YamlLight -> [(String, String)]-getFields (YMap mp) = map toPair $ Map.assocs mp+getFields :: J.Object -> [(Text, Text)]+getFields mp = map toPair $ M.toList mp     where-      toPair (YStr k, YStr v) = (unpack k, unpack v)+      toPair :: (Text, Value) -> (Text, Text)+      toPair (k, J.String v) = (cs k, cs v)+      toPair (k, J.Null) = (cs k, cs ("" :: String))       toPair (k, v) = throwFS $ "Error in YAML input; expected string key and string value, got " ++ (show (k, v)) getFields _ = throwFS "Error in YAML input; expected mapping" -missingFields :: [(String, String)] -> [String]+missingFields :: [(Text, Text)] -> [Text] missingFields fs =     [ k | k <- requiredFields, not (k `elem` inputStrings) ]     where@@ -119,19 +141,19 @@  -- |Given a migration and a list of parsed migration fields, update -- the migration from the field values for recognized fields.-migrationFromFields :: Migration -> [(String, String)] -> Maybe Migration+migrationFromFields :: Migration -> [(Text, Text)] -> Maybe Migration migrationFromFields m [] = Just m migrationFromFields m ((name, value):rest) = do   processor <- lookup name fieldProcessors   newM <- processor value m   migrationFromFields newM rest -requiredFields :: [String]+requiredFields :: [Text] requiredFields = [ "Apply"                  , "Depends"                  ] -fieldProcessors :: [(String, FieldProcessor)]+fieldProcessors :: [(Text, FieldProcessor)] fieldProcessors = [ ("Created", setTimestamp )                   , ("Description", setDescription )                   , ("Apply", setApply )@@ -146,8 +168,8 @@           _ -> fail "expected one valid parse"   return $ m { mTimestamp = Just ts } -readTimestamp :: String -> [(UTCTime, String)]-readTimestamp = reads+readTimestamp :: Text -> [(UTCTime, String)]+readTimestamp = reads . cs  setDescription :: FieldProcessor setDescription desc m = Just $ m { mDesc = Just desc }@@ -159,4 +181,4 @@ setRevert revert m = Just $ m { mRevert = Just revert }  setDepends :: FieldProcessor-setDepends depString m = Just $ m { mDeps = words depString }+setDepends depString m = Just $ m { mDeps = T.words depString }

@@ -1,17 +1,23 @@+{-# LANGUAGE OverloadedStrings #-} module Database.Schema.Migrations.Filesystem.Serialize     ( serializeMigration     ) where +import Data.ByteString ( ByteString )+import qualified Data.ByteString as BS+import Data.Text ( Text )+import qualified Data.Text as T+import Data.String.Conversions ( cs ) import Data.Time () -- for UTCTime Show instance import Data.Maybe ( catMaybes )-import Data.List ( intercalate )+import Data.Monoid ( (<>) )  import Database.Schema.Migrations.Migration     ( Migration(..)     ) -type FieldSerializer = Migration -> Maybe String+type FieldSerializer = Migration -> Maybe ByteString  fieldSerializers :: [FieldSerializer] fieldSerializers = [ serializeDesc@@ -25,48 +31,48 @@ serializeDesc m =     case mDesc m of       Nothing -> Nothing-      Just desc -> Just $ "Description: " ++ desc+      Just desc -> Just . cs $ "Description: " <> desc  serializeTimestamp :: FieldSerializer serializeTimestamp m =     case mTimestamp m of         Nothing -> Nothing-        Just ts -> Just $ "Created: " ++ (show ts)+        Just ts -> Just $ "Created: " <> (cs . show $ ts)  serializeDepends :: FieldSerializer-serializeDepends m = Just $ "Depends: " ++ (intercalate " " $ mDeps m)+serializeDepends m = Just . cs $ "Depends: " <> (T.intercalate " " $ mDeps m)  serializeRevert :: FieldSerializer serializeRevert m =     case mRevert m of       Nothing -> Nothing-      Just revert -> Just $ "Revert: |\n" +++      Just revert -> Just $ "Revert: |\n" <>                      (serializeMultiline revert)  serializeApply :: FieldSerializer-serializeApply m = Just $ "Apply: |\n" ++ (serializeMultiline $ mApply m)+serializeApply m = Just $ "Apply: |\n" <> (serializeMultiline $ mApply m) -commonPrefix :: String -> String -> String-commonPrefix a b = map fst $ takeWhile (uncurry (==)) (zip a b)+commonPrefix :: Text -> Text -> Text+commonPrefix a b = cs . map fst $ takeWhile (uncurry (==)) (T.zip a b) -commonPrefixLines :: [String] -> String+commonPrefixLines :: [Text] -> Text commonPrefixLines [] = "" commonPrefixLines theLines = foldl1 commonPrefix theLines -serializeMultiline :: String -> String+serializeMultiline :: Text -> ByteString serializeMultiline s =-    let sLines = lines s-        prefix = case commonPrefixLines sLines of+    let sLines = T.lines s+        prefix = case T.head $ commonPrefixLines sLines of                    -- If the lines already have a common prefix that                    -- begins with whitespace, no new prefix is                    -- necessary.-                   (' ':_) -> ""+                   ' ' -> ""                    -- Otherwise, use a new prefix of two spaces.                    _ -> "  " -    in unlines $ map (prefix ++) sLines+    in cs . T.unlines $ map (prefix <>) sLines -serializeMigration :: Migration -> String-serializeMigration m = intercalate "\n" fields+serializeMigration :: Migration -> ByteString+serializeMigration m = BS.intercalate "\n" fields     where       fields = catMaybes [ f m | f <- fieldSerializers ]

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Database.Schema.Migrations.Migration     ( Migration(..)     , newMigration@@ -7,15 +8,16 @@  import Database.Schema.Migrations.Dependencies +import Data.Text ( Text ) import Data.Time () -- for UTCTime Show instance import qualified Data.Time.Clock as Clock  data Migration = Migration { mTimestamp :: Maybe Clock.UTCTime-                           , mId :: String-                           , mDesc :: Maybe String-                           , mApply :: String-                           , mRevert :: Maybe String-                           , mDeps :: [String]+                           , mId :: Text+                           , mDesc :: Maybe Text+                           , mApply :: Text+                           , mRevert :: Maybe Text+                           , mDeps :: [Text]                            }                deriving (Eq, Show, Ord) @@ -23,7 +25,7 @@     depsOf = mDeps     depId = mId -emptyMigration :: String -> Migration+emptyMigration :: Text -> Migration emptyMigration name =   Migration { mTimestamp = Nothing             , mId = name@@ -33,7 +35,7 @@             , mDeps = []             } -newMigration :: String -> Migration+newMigration :: Text -> Migration newMigration theId =    (emptyMigration theId)      { mApply = "(Apply SQL here.)"

@@ -23,6 +23,7 @@     ) where +import Data.Text ( Text ) import Data.Maybe ( isJust ) import Control.Monad ( mzero ) import Control.Applicative ( (<$>) )@@ -41,7 +42,7 @@ -- |A mapping from migration name to 'Migration'.  This is exported -- for testing purposes, but you'll want to interface with this -- through the encapsulating 'StoreData' type.-type MigrationMap = Map.Map String Migration+type MigrationMap = Map.Map Text Migration  data StoreData = StoreData { storeDataMapping :: MigrationMap                            , storeDataGraph :: DependencyGraph Migration@@ -51,17 +52,17 @@ -- facility in which new migrations can be created, and from which -- existing migrations can be loaded. data MigrationStore =-    MigrationStore { loadMigration :: String -> IO (Either String Migration)+    MigrationStore { loadMigration :: Text -> IO (Either String Migration)                    -- ^ Load a migration from the store.                     , saveMigration :: Migration -> IO ()                    -- ^ Save a migration to the store. -                   , getMigrations :: IO [String]+                   , getMigrations :: IO [Text]                    -- ^ Return a list of all available migrations'                    -- names. -                   , fullMigrationName :: String -> IO String+                   , fullMigrationName :: Text -> IO FilePath                    -- ^ Return the full representation of a given                    -- migration name; mostly for filesystem stores,                    -- where the full representation includes the store@@ -69,7 +70,7 @@                    }  -- |A type for types of validation errors for migration maps.-data MapValidationError = DependencyReferenceError String String+data MapValidationError = DependencyReferenceError Text Text                           -- ^ A migration claims a dependency on a                           -- migration that does not exist.                         | DependencyGraphError String@@ -96,7 +97,7 @@  -- |A convenience function for looking up a 'Migration' by name in the -- specified 'StoreData'.-storeLookup :: StoreData -> String -> Maybe Migration+storeLookup :: StoreData -> Text -> Maybe Migration storeLookup storeData migrationName =     Map.lookup migrationName $ storeDataMapping storeData @@ -153,6 +154,6 @@  -- |Finds migrations that no other migration depends on (effectively finds all -- vertices with in-degree equal to zero).-leafMigrations :: StoreData -> [String]+leafMigrations :: StoreData -> [Text] leafMigrations s = [l | (n, l) <- labNodes g, indeg g n == 0]     where g = depGraph $ storeDataGraph s

@@ -9,6 +9,8 @@     , tests     ) where +import Data.ByteString ( ByteString )+ import Control.Monad ( forM_ ) import Test.HUnit @@ -30,7 +32,7 @@     withTransaction :: c -> (c -> IO a) -> IO a      -- | Retrieves a list of all tables in the current database/scheme.-    getTables :: c -> IO [String]+    getTables :: c -> IO [ByteString]      catchAll :: c -> (IO a -> IO a -> IO a) @@ -102,7 +104,7 @@         m2 = (newMigration "third") { mApply = "INVALID SQL" }      -- Apply the migrations, ignore exceptions-    ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do+    _ <- ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do         let backend' = makeBackend conn'         applyMigration backend' m1         applyMigration backend' m2@@ -129,7 +131,7 @@      -- Revert the migrations, ignore exceptions; the revert will fail,     -- but withTransaction will roll back.-    ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do+    _ <- ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do         let backend' = makeBackend conn'         revertMigration backend' m2         revertMigration backend' m1

@@ -3,6 +3,8 @@ {-# LANGUAGE OverloadedStrings #-} module Moo.CommandHandlers where +import Data.String.Conversions (cs, (<>))+ import Moo.Core import Moo.CommandUtils import Control.Monad ( when, forM_ )@@ -23,10 +25,10 @@   store      <- asks _appStore   linear     <- asks _appLinearMigrations   timestamp  <- asks _appTimestampFilenames-  timeString <- (++"_") <$> liftIO getCurrentTimestamp+  timeString <- (<>"_") <$> liftIO getCurrentTimestamp    let [migrationId] = if timestamp-      then fmap (timeString++) required+      then fmap (timeString<>) required       else required   noAsk <- _noAsk <$> asks _appOptions @@ -34,15 +36,15 @@     fullPath <- fullMigrationName store migrationId     when (isJust $ storeLookup storeData migrationId) $          do-           putStrLn $ "Migration " ++ (show fullPath) ++ " already exists"+           putStrLn $ "Migration " <> (show fullPath) ++ " already exists"            exitWith (ExitFailure 1)      -- 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+             putStrLn . cs $ "Selecting dependencies for new \+                        \migration: " <> migrationId              interactiveAskDeps storeData      result <- if noAsk then (return True) else@@ -90,7 +92,7 @@                                putStrLn "Database is up to date."                                exitSuccess         putStrLn "Migrations to install:"-        forM_ migrationNames (putStrLn . ("  " ++))+        forM_ migrationNames (putStrLn . cs . ("  " <>))  reinstallCommand :: CommandHandler reinstallCommand storeData = do@@ -102,8 +104,8 @@       ensureBootstrappedBackend backend >> commitBackend backend       m <- lookupMigration storeData migrationId -      revert m storeData backend-      apply m storeData backend True+      _ <- revert m storeData backend+      _ <- apply m storeData backend True        case isTesting of         False -> do@@ -119,7 +121,7 @@       ensureBootstrappedBackend backend >> commitBackend backend       ms <- getMigrations backend       forM_ ms $ \m ->-          when (not $ m == rootMigrationName) $ putStrLn m+          when (not $ m == rootMigrationName) $ putStrLn . cs $ m  applyCommand :: CommandHandler applyCommand storeData = do@@ -130,7 +132,7 @@   withBackend $ \backend -> do         ensureBootstrappedBackend backend >> commitBackend backend         m <- lookupMigration storeData migrationId-        apply m storeData backend True+        _ <- apply m storeData backend True         case isTesting of           False -> do             commitBackend backend@@ -148,7 +150,7 @@   withBackend $ \backend -> do       ensureBootstrappedBackend backend >> commitBackend backend       m <- lookupMigration storeData migrationId-      revert m storeData backend+      _ <- revert m storeData backend        case isTesting of         False -> do@@ -170,7 +172,7 @@         -- If the migration is already installed, remove it as part of         -- the test         when (not $ migrationId `elem` migrationNames) $-             do revert m storeData backend+             do _ <- revert m storeData backend                 return ()         applied <- apply m storeData backend True         forM_ (reverse applied) $ \migration -> do

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} module Moo.CommandUtils        ( apply        , confirmCreation@@ -9,7 +9,10 @@        , getCurrentTimestamp        ) where -import Control.Applicative+import Data.Text ( Text )+import qualified Data.Text as T+import Data.String.Conversions ( cs, (<>) )+ import Control.Exception ( finally ) import Control.Monad ( when, forM_, unless ) import Control.Monad.Reader ( asks )@@ -30,9 +33,9 @@                                         ) import Moo.Core -getCurrentTimestamp :: IO String+getCurrentTimestamp :: IO Text getCurrentTimestamp =-  replace ":" "-" . replace " " "_" . take 19 . show <$> getCurrentTime+  cs . replace ":" "-" . replace " " "_" . take 19 . show <$> getCurrentTime  apply :: Migration -> StoreData -> Backend -> Bool -> IO [Migration] apply m storeData backend complain = do@@ -47,12 +50,12 @@     where       nothingToDo =         when complain $-             putStrLn $ "Nothing to do; " ++-                          mId m +++             putStrLn . cs $ "Nothing to do; " <>+                          mId m <>                           " already installed."        applyIt conn it = do-        putStr $ "Applying: " ++ mId it ++ "... "+        putStr . cs $ "Applying: " <> mId it <> "... "         applyMigration conn it         putStrLn "done." @@ -68,22 +71,22 @@      where       nothingToDo =-        putStrLn $ "Nothing to do; " ++-                 mId m +++        putStrLn . cs $ "Nothing to do; " <>+                 mId m <>                  " not installed."        revertIt conn it = do-        putStr $ "Reverting: " ++ mId it ++ "... "+        putStr . cs $ "Reverting: " <> mId it <> "... "         revertMigration conn it         putStrLn "done."  -lookupMigration :: StoreData -> String -> IO Migration+lookupMigration :: StoreData -> Text -> IO Migration lookupMigration storeData name = do   let theMigration = storeLookup storeData name   case theMigration of     Nothing -> do-      putStrLn $ "No such migration: " ++ name+      putStrLn . cs $ "No such migration: " <> name       exitWith (ExitFailure 1)     Just m' -> return m' @@ -97,13 +100,13 @@  -- Given a migration name and selected dependencies, get the user's -- confirmation that a migration should be created.-confirmCreation :: String -> [String] -> IO Bool+confirmCreation :: Text -> [Text] -> IO Bool confirmCreation migrationId deps = do   putStrLn ""-  putStrLn $ "Confirm: create migration '" ++ migrationId ++ "'"+  putStrLn . cs $ "Confirm: create migration '" <> migrationId <> "'"   if null deps then putStrLn "  (No dependencies)"      else putStrLn "with dependencies:"-  forM_ deps $ \d -> putStrLn $ "  " ++ d+  forM_ deps $ \d -> putStrLn . cs $ "  " <> d   prompt "Are you sure?" [ ('y', (True, Nothing))                          , ('n', (False, Nothing))                          ]@@ -162,7 +165,7 @@  -- Interactively ask the user about which dependencies should be used -- when creating a new migration.-interactiveAskDeps :: StoreData -> IO [String]+interactiveAskDeps :: StoreData -> IO [Text] interactiveAskDeps storeData = do   -- For each migration in the store, starting with the most recently   -- added, ask the user if it should be added to a dependency list@@ -174,10 +177,10 @@ -- Recursive function to prompt the user for dependencies and let the -- user view information about potential dependencies.  Returns a list -- of migration names which were selected.-interactiveAskDeps' :: StoreData -> [String] -> IO [String]+interactiveAskDeps' :: StoreData -> [Text] -> IO [Text] interactiveAskDeps' _ [] = return [] interactiveAskDeps' storeData (name:rest) = do-  result <- prompt ("Depend on '" ++ name ++ "'?") askDepsChoices+  result <- prompt ("Depend on '" ++ cs name ++ "'?") askDepsChoices   if result == Done then return [] else         case result of           Yes -> do@@ -189,12 +192,12 @@             let Just m = storeLookup storeData name             -- print out description, timestamp, deps             when (isJust $ mDesc m)-                     (putStrLn $ "  Description: " +++                     (putStrLn . cs $ "  Description: " <>                                     fromJust  (mDesc m))             putStrLn $ "      Created: " ++ show (mTimestamp m)             unless (null $ mDeps m)-                     (putStrLn $ "  Deps: " ++-                                   intercalate "\n        "  (mDeps m))+                     (putStrLn . cs $ "  Deps: " <>+                                   T.intercalate "\n        "  (mDeps m))             -- ask again             interactiveAskDeps' storeData (name:rest)           Quit -> do

@@ -13,7 +13,8 @@     , envStoreName     , loadConfiguration) where -import Control.Applicative+import Data.Text ( Text )+ import Control.Monad.Reader (ReaderT) import qualified Data.Configurator as C import Data.Configurator.Types (Config, Configured)@@ -34,8 +35,8 @@ -- |Application state which can be accessed by any command handler. data AppState = AppState { _appOptions            :: CommandOptions                          , _appCommand            :: Command-                         , _appRequiredArgs       :: [String]-                         , _appOptionalArgs       :: [String]+                         , _appRequiredArgs       :: [Text]+                         , _appOptionalArgs       :: [Text]                          , _appBackend            :: Backend                          , _appStore              :: MigrationStore                          , _appStoreData          :: StoreData

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Moo.Main     ( mainWithParameters     , ExecutableParameters (..)@@ -12,6 +13,8 @@ import  Control.Monad.Reader (forM_, runReaderT, when) import  Database.HDBC (SqlError, catchSql, seErrorMsg) import  Prelude  hiding (lookup)+import  Data.Text (Text)+import  Data.String.Conversions (cs) import  System.Environment (getProgName) import  System.Exit (ExitCode (ExitFailure), exitWith) @@ -77,8 +80,8 @@           Right storeData -> do             let st = AppState { _appOptions = opts                               , _appCommand = command-                              , _appRequiredArgs = required-                              , _appOptionalArgs = ["" :: String]+                              , _appRequiredArgs = map cs required+                              , _appOptionalArgs = ["" :: Text]                               , _appBackend = _parametersBackend parameters                               , _appStore = store                               , _appStoreData = storeData

@@ -8,6 +8,8 @@     ) where +import Data.Text ( Text )+ import CommonTH import System.FilePath ( (</>) ) import Language.Haskell.TH.Syntax (lift)@@ -25,8 +27,8 @@     depId = tdId     depsOf = tdDeps -data TestDependable = TD { tdId :: String-                         , tdDeps :: [String]+data TestDependable = TD { tdId :: Text+                         , tdDeps :: [Text]                          }                       deriving (Show, Eq, Ord) 

@@ -1,8 +1,11 @@+{-# LANGUAGE OverloadedStrings #-} module DependencyTest     ( tests     ) where +import Data.Text ( Text )+ import Test.HUnit import Data.Graph.Inductive.Graph ( Graph(..) ) @@ -39,7 +42,7 @@ mkDepGraphTest (input, expected) = expected ~=? mkDepGraph input  data Direction = Forward | Reverse deriving (Show)-type DependencyTestCase = ([TestDependable], String, Direction, [String])+type DependencyTestCase = ([TestDependable], Text, Direction, [Text])  dependencyTestCases :: [DependencyTestCase] dependencyTestCases = [ ([TD "first" []], "first", Forward, [])

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module FilesystemParseTest     ( tests     )@@ -6,6 +7,7 @@ import Test.HUnit import Data.Time.Clock ( UTCTime ) import System.FilePath ( (</>) )+import Data.String.Conversions ( cs )  import Common @@ -84,34 +86,33 @@                               , Right (valid_full { mId = "valid_no_timestamp", mTimestamp = Nothing }))                             , ("invalid_missing_required_fields"                               , Left $ "Could not parse migration " ++-                                         (fp "invalid_missing_required_fields.txt") +++                                         (fp "invalid_missing_required_fields") ++                                          ":Error in " ++-                                         (show $ fp "invalid_missing_required_fields.txt") +++                                         (show $ fp "invalid_missing_required_fields") ++                                          ": missing required field(s): " ++                                          "[\"Depends\"]")                             , ("invalid_field_name"                               , Left $ "Could not parse migration " ++-                                         (fp "invalid_field_name.txt") +++                                         (fp "invalid_field_name") ++                                          ":Error in " ++-                                         (show $ fp "invalid_field_name.txt") +++                                         (show $ fp "invalid_field_name") ++                                          ": unrecognized field found")                             , ("invalid_syntax"                               , Left $ "Could not parse migration " ++-                                         (fp "invalid_syntax.txt") ++-                                         ":user error (syntax error: line 7, " ++-                                         "column 0)")+                                         (fp "invalid_syntax") +++                                         ":InvalidYaml (Just (YamlParseException {yamlProblem = \"could not find expected ':'\", yamlContext = \"while scanning a simple key\", yamlProblemMark = YamlMark {yamlIndex = 130, yamlLine = 6, yamlColumn = 0}}))")                             , ("invalid_timestamp"                               , Left $ "Could not parse migration " ++-                                         (fp "invalid_timestamp.txt") +++                                         (fp "invalid_timestamp") ++                                          ":Error in " ++-                                         (show $ fp "invalid_timestamp.txt") +++                                         (show $ fp "invalid_timestamp") ++                                          ": unrecognized field found")                             ]  mkParsingTest :: MigrationParsingTestCase -> IO Test mkParsingTest (fname, expected) = do   let store = FSStore { storePath = testStorePath }-  actual <- migrationFromFile store fname+  actual <- migrationFromFile store (cs fname)   return $ test $ expected ~=? actual  migrationParsingTests :: IO [Test]

@@ -1,9 +1,12 @@+{-# LANGUAGE OverloadedStrings #-} module FilesystemSerializeTest     ( tests     ) where  import Test.HUnit+import Data.ByteString ( ByteString )+import Data.String.Conversions ( (<>), cs ) import Data.Time.Clock ( UTCTime )  import Database.Schema.Migrations.Filesystem.Serialize@@ -12,7 +15,7 @@ tests :: [Test] tests = serializationTests -mkSerializationTest :: (Migration, String) -> Test+mkSerializationTest :: (Migration, ByteString) -> Test mkSerializationTest (m, expectedString) = test $ expectedString ~=? serializeMigration m  tsStr :: String@@ -31,9 +34,9 @@              , mRevert = Just "DROP TABLE test;"              } -serializationTestCases :: [(Migration, String)]-serializationTestCases = [ (valid_full, "Description: A valid full migration.\n\-                                        \Created: " ++ tsStr ++ "\n\+serializationTestCases :: [(Migration, ByteString)]+serializationTestCases = [ (valid_full, cs $ "Description: A valid full migration.\n\+                                        \Created: " <> tsStr <> "\n\                                         \Depends: another_migration\n\                                         \Apply: |\n\                                         \  CREATE TABLE test (\n\@@ -42,7 +45,7 @@                                         \Revert: |\n\                                         \  DROP TABLE test;\n")                          , (valid_full { mDesc = Nothing }-                           , "Created: " ++ tsStr ++ "\n\+                           , cs $ "Created: " <> tsStr <> "\n\                              \Depends: another_migration\n\                              \Apply: |\n\                              \  CREATE TABLE test (\n\@@ -51,8 +54,8 @@                              \Revert: |\n\                              \  DROP TABLE test;\n")                          , (valid_full { mDeps = ["one", "two"] }-                           , "Description: A valid full migration.\n\-                             \Created: " ++ tsStr ++ "\n\+                           , cs $ "Description: A valid full migration.\n\+                             \Created: " <> tsStr <> "\n\                              \Depends: one two\n\                              \Apply: |\n\                              \  CREATE TABLE test (\n\@@ -61,8 +64,8 @@                              \Revert: |\n\                              \  DROP TABLE test;\n")                          , (valid_full { mRevert = Nothing }-                           , "Description: A valid full migration.\n\-                             \Created: " ++ tsStr ++ "\n\+                           , cs $ "Description: A valid full migration.\n\+                             \Created: " <> tsStr <> "\n\                              \Depends: another_migration\n\                              \Apply: |\n\                              \  CREATE TABLE test (\n\

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module FilesystemTest     ( tests     )

@@ -1,10 +1,13 @@ module InMemoryStore (inMemoryStore) where +import Data.Text ( Text )+import Data.String.Conversions ( cs )+ import           Control.Concurrent.MVar import           Database.Schema.Migrations.Migration import           Database.Schema.Migrations.Store -type InMemoryData = [(String, Migration)]+type InMemoryData = [(Text, Migration)]  -- |Builds simple in-memory store that uses 'MVar' to preserve a list of -- migrations.@@ -15,10 +18,10 @@       loadMigration = loadMigrationInMem store     , saveMigration = saveMigrationInMem store     , getMigrations = getMigrationsInMem store-    , fullMigrationName = return+    , fullMigrationName = return . cs     } -loadMigrationInMem :: MVar InMemoryData -> String -> IO (Either String Migration)+loadMigrationInMem :: MVar InMemoryData -> Text -> IO (Either String Migration) loadMigrationInMem store migId = withMVar store $ \migrations -> do     let mig = lookup migId migrations     return $ case mig of@@ -28,5 +31,5 @@ saveMigrationInMem :: MVar InMemoryData -> Migration -> IO () saveMigrationInMem store m = modifyMVar_ store $ return . ((mId m, m):) -getMigrationsInMem :: MVar InMemoryData -> IO [String]+getMigrationsInMem :: MVar InMemoryData -> IO [Text] getMigrationsInMem store = withMVar store $ return . fmap fst

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module LinearMigrationsTest (tests) where  import           InMemoryStore@@ -5,6 +6,7 @@  import           Common import           Control.Monad.Reader                 (runReaderT)+import           Data.Text                            (Text) import           Data.Either                          (isRight) import           Database.Schema.Migrations.Migration import           Database.Schema.Migrations.Store@@ -60,13 +62,13 @@     runReaderT (newCommand $ _appStoreData state) state     loadMigration store migrationId -addTestMigrationWithDeps :: AppState -> [String] -> IO ()+addTestMigrationWithDeps :: AppState -> [Text] -> IO () addTestMigrationWithDeps state deps = do     let store = _appStore state     let [migrationId] = _appRequiredArgs state     saveMigration store (newMigration migrationId) { mDeps = deps } -prepareState :: String -> IO AppState+prepareState :: Text -> IO AppState prepareState m = do     store <- inMemoryStore     Right storeData <- loadMigrations store@@ -82,12 +84,12 @@     , _appTimestampFilenames = False     } -prepareStateWith :: AppState -> String -> IO AppState+prepareStateWith :: AppState -> Text -> IO AppState prepareStateWith state m = do     Right storeData <- loadMigrations $ _appStore state     return state { _appRequiredArgs = [m], _appStoreData = storeData } -prepareNormalState :: String -> IO AppState+prepareNormalState :: Text -> IO AppState prepareNormalState m = do     state <- prepareState m     return $ state { _appLinearMigrations = False }

@@ -0,0 +1,51 @@+module Main where+import Prelude+import Test.HUnit+import System.Exit+import System.IO ( stderr )++import qualified DependencyTest+import qualified MigrationsTest+import qualified FilesystemSerializeTest+import qualified FilesystemParseTest+import qualified FilesystemTest+import qualified CycleDetectionTest+import qualified StoreTest+import qualified LinearMigrationsTest+import qualified ConfigurationTest++import Control.Exception ( SomeException(..) )++loadTests :: IO [Test]+loadTests = do++  ioTests <- sequence [ do fspTests <- FilesystemParseTest.tests+                           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 [ ioTests+                  , DependencyTest.tests+                  , FilesystemSerializeTest.tests+                  , MigrationsTest.tests+                  , CycleDetectionTest.tests+                  , StoreTest.tests+                  ]++tempDatabase :: String+tempDatabase = "dbmigrations_test"++ignoreException :: SomeException -> IO ()+ignoreException _ = return ()++main :: IO ()+main = do+  tests <- loadTests+  (testResults, _) <- runTestText (putTextToHandle stderr False) $ test tests+  if errors testResults + failures testResults > 0+    then exitFailure+    else exitSuccess

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances,GeneralizedNewtypeDeriving,MultiParamTypeClasses,FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances,GeneralizedNewtypeDeriving,MultiParamTypeClasses,FlexibleInstances,OverloadedStrings #-} module MigrationsTest     ( tests     )

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module StoreTest     ( tests     )

@@ -1,51 +0,0 @@-module Main where-import Prelude-import Test.HUnit-import System.Exit-import System.IO ( stderr )--import qualified DependencyTest-import qualified MigrationsTest-import qualified FilesystemSerializeTest-import qualified FilesystemParseTest-import qualified FilesystemTest-import qualified CycleDetectionTest-import qualified StoreTest-import qualified LinearMigrationsTest-import qualified ConfigurationTest--import Control.Exception ( SomeException(..) )--loadTests :: IO [Test]-loadTests = do--  ioTests <- sequence [ do fspTests <- FilesystemParseTest.tests-                           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 [ ioTests-                  , DependencyTest.tests-                  , FilesystemSerializeTest.tests-                  , MigrationsTest.tests-                  , CycleDetectionTest.tests-                  , StoreTest.tests-                  ]--tempDatabase :: String-tempDatabase = "dbmigrations_test"--ignoreException :: SomeException -> IO ()-ignoreException _ = return ()--main :: IO ()-main = do-  tests <- loadTests-  (testResults, _) <- runTestText (putTextToHandle stderr False) $ test tests-  if errors testResults + failures testResults > 0-    then exitFailure-    else exitSuccess