drifter-postgresql 0.0.2 → 0.1.0

raw patch · 4 files changed

+54/−32 lines, 4 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• README.md +1/−0
• changelog.md +2/−0
• drifter-postgresql.cabal +4/−2
• src/Drifter/PostgreSQL.hs +47/−30

@@ -1,4 +1,5 @@ # drifter-postgresql+[![Build Status](https://travis-ci.org/MichaelXavier/drifter-postgresql.svg?branch=master)](https://travis-ci.org/MichaelXavier/drifter-postgresql)  PostgreSQL support for the drifter schema migration tool 

@@ -1,3 +1,5 @@+0.1.0+* Support non-linear migration plans. This changes some types, hence a breaking version change. 0.0.2 * Loosen bounds 0.0.1

@@ -1,5 +1,5 @@ name:                drifter-postgresql-version:             0.0.2+version:             0.1.0 synopsis:            PostgreSQL support for the drifter schema migration tool description:         Support for postgresql-simple Query migrations as well as                      arbitrary Haskell IO functions. Be sure to check the@@ -16,7 +16,8 @@   README.md   changelog.md   examples/Example.hs-  test/Main.hs+homepage:           http://github.com/michaelxavier/drifter-postgresql+bug-reports:        http://github.com/michaelxavier/drifter-postgresql/issues  flag lib-Werror   default: False@@ -26,6 +27,7 @@   exposed-modules:   Drifter.PostgreSQL   build-depends:       base >=4.5 && <5                      , postgresql-simple >= 0.2+                     , containers                      , drifter >= 0.2                      , time                      , either

@@ -12,6 +12,7 @@     , ChangeHistory(..)     , runMigrations     , getChangeHistory+    , getChangeNameHistory     ) where  -------------------------------------------------------------------------------@@ -20,6 +21,8 @@ import           Control.Monad import           Control.Monad.Trans import           Control.Monad.Trans.Either+import           Data.Set (Set)+import qualified Data.Set as Set import           Data.Time import           Database.PostgreSQL.Simple import           Database.PostgreSQL.Simple.FromField@@ -38,12 +41,15 @@                                  -- ^ Run any arbitrary IO code  -data instance DBConnection PGMigration = DBConnection Connection+data instance DBConnection PGMigration = DBConnection PGMigrationConnection  +data PGMigrationConnection = PGMigrationConnection (Set ChangeName) Connection++ instance Drifter PGMigration where-  migrateSingle (DBConnection conn) change = do-    runEitherT $ migrateChange conn change+  migrateSingle (DBConnection migrationConn) change = do+    runEitherT $ migrateChange migrationConn change   -------------------------------------------------------------------------------@@ -99,31 +105,26 @@   --------------------------------------------------------------------------------insertLogQ :: Query-insertLogQ =-  "INSERT INTO schema_migrations (name, description, time) VALUES (?, ?, ?);"+changeNameHistoryQ :: Query+changeNameHistoryQ =+  "SELECT name FROM schema_migrations ORDER BY id;"   --------------------------------------------------------------------------------findNext :: [ChangeHistory] -> [Change PGMigration] -> IO [Change PGMigration]-findNext [] cs = return cs-findNext (h:hs) (c:cs)-  | (histName h) == (changeName c) = do-    putStrLn $ "Skipping: " ++ show (changeNameText (changeName c))-    findNext hs cs-  | otherwise = return (c:cs)-findNext _ _ = do-  putStrLn "Change Set Exhausted"-  return []+insertLogQ :: Query+insertLogQ =+  "INSERT INTO schema_migrations (name, description, time) VALUES (?, ?, ?);"   --------------------------------------------------------------------------------migrateChange :: Connection -> Change PGMigration -> EitherT String IO ()-migrateChange c ch@Change{..} = do-  runMethod c changeMethod--  logChange c ch-  lift $ putStrLn $ "Committed: " ++ show changeName+migrateChange :: PGMigrationConnection -> Change PGMigration -> EitherT String IO ()+migrateChange (PGMigrationConnection hist c) ch@Change{..} = do+  if Set.member changeName hist+    then lift $ putStrLn $ "Skipping: " ++ show (changeNameText changeName)+    else do+      runMethod c changeMethod+      logChange c ch+      lift $ putStrLn $ "Committed: " ++ show changeName   -------------------------------------------------------------------------------@@ -153,24 +154,40 @@   -------------------------------------------------------------------------------+-- | Takes a connection and builds the state to thread throughout the migration.+-- This includes bootstrapping the migration tables and collecting all the+-- migrations that have already been committed.+makePGMigrationConnection :: Connection -> IO PGMigrationConnection+makePGMigrationConnection conn = do+  void $ execute_ conn bootstrapQ+  hist <- getChangeNameHistory conn+  return $ PGMigrationConnection (Set.fromList hist) conn+++------------------------------------------------------------------------------- -- | Takes the list of all migrations, removes the ones that have -- already run and runs them. Use this instead of 'migrate'. runMigrations :: Connection -> [Change PGMigration] -> IO (Either String ()) runMigrations conn changes = do-  void $ execute_ conn bootstrapQ-  hist <- getChangeHistory conn-  remainingChanges <- findNext hist changes   begin conn-  res <- migrate (DBConnection conn) remainingChanges `onException` rollback conn+  migrationConn <- makePGMigrationConnection conn+  res <- migrate (DBConnection migrationConn) changes `onException` rollback conn   case res of     Right _ -> commit conn-    Left _ -> rollback conn+    Left  _ -> rollback conn   return res   ---------------------------------------------------------------------------------- | Check the schema_migrations table for all the migrations that--- have previously run. This is run internally by 'runMigrations' to--- determine which migrations to run.+-- | Get all changes from schema_migrations table for all the migrations that+-- have previously run. getChangeHistory :: Connection -> IO [ChangeHistory] getChangeHistory conn = query_ conn changeHistoryQ+++-------------------------------------------------------------------------------+-- | Get just the names of all changes from schema_migrations for migrations+-- that have previously run.+getChangeNameHistory :: Connection -> IO [ChangeName]+getChangeNameHistory conn = fmap (\(Only name) -> ChangeName name)+                        <$> query_ conn changeNameHistoryQ