diff --git a/database-migrate.cabal b/database-migrate.cabal
--- a/database-migrate.cabal
+++ b/database-migrate.cabal
@@ -1,5 +1,5 @@
 Name:               database-migrate
-Version:            0.1.2
+Version:            0.2.0
 License:            BSD3
 License-File:       LICENSE
 Author:             Mark Hibberd <mark@hibberd.id.au>
@@ -40,6 +40,7 @@
                     , either                        >= 3.0.2
                     , transformers                  >= 0.2
                     , cmdargs                       >= 0.9.3
+                    , lens                          >= 3.9.0.2
 
   GHC-Options:
                     -Wall -fno-warn-orphans
@@ -49,8 +50,10 @@
 
   Exposed-Modules:
                     Database.Migrate
-                    Database.Migrate.Data
-                    Database.Migrate.Kernel
-                    Database.Migrate.Loader
-                    Database.Migrate.Main
                     Database.Migrate.PostgreSQL
+                    Database.Migrate.Migration
+                    Database.Migrate.Migration.Ddl
+                    Database.Migrate.Migration.Directory
+                    Database.Migrate.Migration.File
+                    Database.Migrate.Migration.FileStandard
+                    Database.Migrate.Migration.FileInferred
diff --git a/src/Database/Migrate.hs b/src/Database/Migrate.hs
--- a/src/Database/Migrate.hs
+++ b/src/Database/Migrate.hs
@@ -16,8 +16,5 @@
 --
 module Database.Migrate (module X) where
 
-import Database.Migrate.Data as X
-import Database.Migrate.Kernel as X
-import Database.Migrate.Loader as X
-import Database.Migrate.Main as X
+import Database.Migrate.Migration as X
 import Database.Migrate.PostgreSQL as X
diff --git a/src/Database/Migrate/Data.hs b/src/Database/Migrate/Data.hs
deleted file mode 100644
--- a/src/Database/Migrate/Data.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-{-#LANGUAGE RankNTypes, ScopedTypeVariables #-}
-module Database.Migrate.Data where
-
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Writer
-import Control.Monad.Trans.Maybe
-
-import Data.Text hiding (foldr, filter, reverse, length)
-
-data MigrationId =
-  MigrationId { extract :: Text } deriving (Eq, Show)
-
-instance Ord MigrationId where
-  compare a b =
-   case (reads . unpack . extract $ a, reads . unpack . extract $ b) of
-     ([(i :: Int, "")], [(j :: Int, "")]) -> compare i j
-     _ -> compare (extract a) (extract b)
-
-data MigrationLog =
-    DatabaseInitialized
-  | MigrationApplied Migration
-  | MigrationFailed Migration String
-  | MigrationRolledback Migration String
-  deriving (Eq, Show)
-
-data Migration =
-  Migration {
-      migrationId :: MigrationId
-    , up :: Text
-    , down :: Text
-    } deriving (Eq, Show)
-
-instance Ord Migration where
-  compare a b = compare (migrationId a) (migrationId b)
-
-data MigrationRecords =
-    NotInitialized
-  | Initialized [MigrationId]
-
--- FIX should not be a list, want to index and sort migrations
-data Migrations =
-  Migrations { getMigrations :: [Migration] }
-
-data Migrate c m a =
-  Migrate { runMigrate :: ReaderT (Migrations, c) (MaybeT (WriterT [MigrationLog] m)) a }
-
--- FIX consider adding history
--- FIX add reverse engineer to extract current schema
-data MigrateDatabase m c =
-  MigrateDatabase {
-      current :: Migrate c m MigrationRecords
-    , initialize :: Migrate c m ()
-    , runSql :: Text -> Migrate c m ()
-    , recordInstall :: Migration -> Migrate c m ()
-    , recordRollback :: Migration -> Migrate c m ()
-    }
-
-instance Monad f => Functor (Migrate c f) where
-  fmap f a = a >>= \a' -> return (f a')
-
-instance Monad m => Monad (Migrate c m) where
-  return a = Migrate $ return a
-  m >>= f = Migrate $ do
-    a <- runMigrate m
-    runMigrate (f a)
-
-instance MonadTrans (Migrate c) where
-  lift = Migrate . lift . lift . lift
-
-instance MonadIO m => MonadIO (Migrate c m) where
-  liftIO = lift . liftIO
diff --git a/src/Database/Migrate/Kernel.hs b/src/Database/Migrate/Kernel.hs
deleted file mode 100644
--- a/src/Database/Migrate/Kernel.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-#LANGUAGE RankNTypes, ScopedTypeVariables #-}
-module Database.Migrate.Kernel where
-
-import Database.Migrate.Data
-
-import Control.Monad
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Writer
-
-import qualified Data.Set as S
-import Data.Functor
-
-mlog :: Monad m => MigrationLog -> Migrate c m ()
-mlog l = Migrate . lift . lift $ tell [l]
-
-connection :: (Functor m, Monad m) => Migrate c m c
-connection = Migrate $ fmap snd ask
-
-store :: (Functor m, Monad m) => Migrate c m Migrations
-store = Migrate $ fmap fst ask
-
-dryrun :: Monad m => MigrateDatabase m c -> MigrateDatabase m c
-dryrun db =
-  MigrateDatabase {
-      current = current db
-    , initialize = return ()
-    , runSql = \_ -> return ()
-    , recordInstall = \_ -> return ()
-    , recordRollback = \_ -> return ()
-    }
-
-migrate :: (Functor m, Monad m) => MigrateDatabase m c -> Migrate c m ()
-migrate db =
-  do records <- current db
-     ms <- store
-     migrations <- case records of
-       NotInitialized -> getMigrations ms <$ (mlog DatabaseInitialized >> initialize db)
-       Initialized mids -> return $ missing ms mids
-     forM_ migrations (\m -> mlog (MigrationApplied m) >> (runSql db (up m) >> recordInstall db m))
-
-missing :: Migrations -> [MigrationId] -> [Migration]
-missing ms applied =
-  let migrations = getMigrations ms
-      available = foldr (S.insert . migrationId) S.empty migrations
-      installed = S.fromList applied
-      torun = S.difference available installed
-   in filter (\m -> S.member (migrationId m) torun) migrations
-
-executeMigrate :: Monad m => Migrations -> c -> Migrate c m a -> m (Maybe a, [MigrationLog])
-executeMigrate = \ms c m -> runWriterT (runMaybeT (runReaderT (runMigrate m) (ms, c)))
diff --git a/src/Database/Migrate/Loader.hs b/src/Database/Migrate/Loader.hs
deleted file mode 100644
--- a/src/Database/Migrate/Loader.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Database.Migrate.Loader where
-
-import Database.Migrate.Data
-
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Either
-
-import Data.List (sort)
-import Data.Text hiding (filter, length)
-
-import System.FilePath
-import System.Directory
-import System.IO
-
-find :: FilePath -> EitherT String IO Migrations
-find b = liftIO (getDirectoryContents b) >>= \fs -> liftM sort (liftIO (migrationids b fs) >>=
-  mapM (\p ->
-         do downexists <- liftIO $ doesFileExist (b </> p <.> "down.sql")
-            unless downexists (left $ "no down.sql for migration [" ++ p ++ "]")
-            u <- liftIO . readFile $ b </> p <.> "up.sql"
-            d <- liftIO . readFile $ b </> p <.> "down.sql"
-            right (Migration (MigrationId . pack $ p) (pack u) (pack d) ))) >>= \ms -> return $ Migrations ms
-
-migrationids :: FilePath -> [FilePath] -> IO [String]
-migrationids b ps =
-  filterM (\p -> doesFileExist (b </> p)) ps >>= \files ->
-    ((return . fmap dropExtensions)
-      (filter (\p -> takeExtensions p == ".up.sql") files))
-
-readFile' :: FilePath -> IO String
-readFile' p = withFile p ReadMode hGetContents
-
-hGetContents' :: Handle -> IO String
-hGetContents' h = hGetContents h >>= \s -> length s `seq` return s
diff --git a/src/Database/Migrate/Main.hs b/src/Database/Migrate/Main.hs
deleted file mode 100644
--- a/src/Database/Migrate/Main.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Database.Migrate.Main (defaultMain, defaultMain') where
-
---import qualified Paths_database_migrate as Program (version)
-
-import Control.Monad
-import Control.Monad.Trans.Either
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Writer
-import Control.Monad.Trans.Maybe
-
-import qualified Data.Text as T
-import Data.Maybe
---import Data.Version (showVersion)
-
-import Database.Migrate.Data
-import Database.Migrate.Kernel
-import Database.Migrate.Loader
-import Database.Migrate.PostgreSQL
-
-import qualified Database.PostgreSQL.Simple as PG
-
-import System.Console.CmdArgs.Explicit
-import System.Directory
-import System.FilePath
-import System.Exit
-import System.Environment (getArgs)
-import System.IO
-
-ignore :: Arg Arguments
-ignore = flagArg (\_ a -> Right a) ""
-
-e :: String
-e = ""
-
-usage = [
-    "usage: db migrate [-v|--verbose] [-d|--dry-run]"
-  , "       db up [-v|--verbose] [-d|--dry-run]"
-  , "       db down [-v|--verbose] [-d|--dry-run]"
-  , "       db apply [-v|--verbose] [-d|--dry-run]"
-  , "       db -h|--help"
-  , "       db -V|--version"
-  ]
-
-
-globalflags :: [Flag Arguments]
-globalflags = [
-    flagNone [ "h", "help" ]     (\a -> a { adbmode = HelpMode })    e
-  , flagNone [ "V", "version" ]  (\a -> a { adbmode = VersionMode }) e
-  ]
-
-connectflags :: [Flag Arguments]
-connectflags = [
-    flagNone [ "v", "verbose" ]    (\a -> a { averbose = True }) e
-  , flagNone [ "d", "dry-run" ]    (\a -> a { adry = True }) e
-  ]
-
-versionflag = (flagArg (\v a -> Right $ a { aversion = Just v }) "VERSION")
-
-cmdmodes :: String -> Arguments -> Mode Arguments
-cmdmodes cmd initial =
-  modes cmd initial "" [
-      mode "migrate" (initial { adbmode = MigrateMode }) "" ignore connectflags
-    , mode "up" (initial { adbmode = UpMode }) "" versionflag connectflags
-    , mode "down" (initial { adbmode = DownMode }) "" versionflag connectflags
-    , mode "apply" (initial { adbmode = ApplyMode }) "" versionflag connectflags
-    , mode "help" (initial { adbmode = HelpMode }) "" ignore []
-    , mode "version" (initial { adbmode = VersionMode }) "" ignore []
-    ]
-
-data DbMode =
-    HelpMode
-  | VersionMode
-  | MigrateMode
-  | UpMode
-  | DownMode
-  | ApplyMode
-  deriving (Eq, Show)
-
-data Arguments = Arguments {
-    adbmode :: DbMode
-  , adry :: Bool
-  , averbose :: Bool
-  , ascripts :: String
-  , aversion :: Maybe String
-  } deriving (Eq, Show)
-
-defaultArguments cwd = Arguments {
-    adbmode = HelpMode
-  , adry = False
-  , averbose = False
-  , ascripts = cwd </> "migrations"
-  , aversion = Nothing
-  }
-
-defaultMain :: Migrations -> MigrateDatabase IO c -> IO c -> IO ()
-defaultMain migrationstore db connector = getArgs >>= defaultMain' migrationstore db connector
-
-defaultMain' :: Migrations -> MigrateDatabase IO c -> IO c -> [String] -> IO ()
-defaultMain' migrationstore db connector args =
-  getCurrentDirectory >>= \cwd ->
-    case process ((cmdmodes "migrate" (defaultArguments cwd)) {modeGroupFlags = toGroup $ globalflags} ) args of
-      Left x ->  hPutStrLn stderr x >> exitFailure
-      Right x -> run migrationstore db connector x
-
-run :: Migrations -> MigrateDatabase IO c -> IO c -> Arguments -> IO ()
-run migrationstore db' connector args =
-  let db = if adry args then dryrun db' else db'
-  in case adbmode args of
-    HelpMode -> mapM_ putStrLn usage
-    VersionMode -> putStrLn $ "migrate 0.1.1" -- ++ showVersion Program.version
-    MigrateMode -> connector  >>= \c -> (executeMigrate migrationstore c $ migrate db) >>= print
-    UpMode -> connector >>= \c -> (executeMigrate migrationstore c $ upmode db) >>= print
-    DownMode -> connector >>= \c -> (executeMigrate migrationstore c $ downmode db) >>= print
-    ApplyMode -> connector >>= \c -> (executeMigrate migrationstore c $ applymode db) >>= print
-
-bomb failwith =
-  putStrLn failwith >> exitFailure
-
-upmode :: MigrateDatabase m c -> Migrate c m ()
-upmode = undefined
-
-downmode :: MigrateDatabase m c -> Migrate c m ()
-downmode = undefined
-
-applymode :: MigrateDatabase m c -> Migrate c m ()
-applymode = undefined
diff --git a/src/Database/Migrate/Migration.hs b/src/Database/Migrate/Migration.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Migration.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE TemplateHaskell, LiberalTypeSynonyms #-}
+module Database.Migrate.Migration where
+
+import Data.Text
+import Control.Lens
+
+type MigrationId = Text
+
+data Change =
+    Ddl Text
+  | DdlFile FilePath
+  | Dud Text
+  | NoOp
+  deriving (Show, Eq)
+-- TODO | AddTable Text TableDef
+-- TODO | AddColumn Text Text ColumnDef
+-- TODO | DropTable Text
+-- TODO | DropColumn Text
+-- TODO | AlterColumn Text Text ColumnDef
+
+
+data Migration =
+    Migration { _migrationId :: MigrationId, _upChange :: Change, _downChange :: Change }
+
+makeLenses ''Migration
diff --git a/src/Database/Migrate/Migration/Ddl.hs b/src/Database/Migrate/Migration/Ddl.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Migration/Ddl.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Database.Migrate.Migration.Ddl (
+  migration
+, up
+, down
+) where
+
+import Database.Migrate.Migration
+import Data.Text
+
+migration :: MigrationId -> Text -> Text -> Migration
+migration mid up' down' =
+  Migration mid (Ddl up') (Ddl down')
+
+up :: MigrationId -> Text -> Migration
+up mid up' =
+  Migration mid (Ddl up') NoOp
+
+down :: MigrationId -> Text -> Migration
+down mid down' =
+  Migration mid NoOp (Ddl down')
diff --git a/src/Database/Migrate/Migration/Directory.hs b/src/Database/Migrate/Migration/Directory.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Migration/Directory.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Database.Migrate.Migration.Directory (
+  migration
+) where
+
+import           Control.Applicative ((<$>))
+import           Data.List (isSuffixOf, intercalate, groupBy)
+import           Data.Text (Text, pack)
+
+import           Database.Migrate.Migration
+import qualified Database.Migrate.Migration.FileInferred as File
+import           System.FilePath
+import           System.Directory
+
+-- TODO support baselines as well as change files
+
+migration :: FilePath -> IO (Either Text [Migration])
+migration path =
+  (mkmigration . filter isMigrationFile) <$> getDirectoryContents path
+
+unsuffix :: FilePath -> FilePath
+unsuffix =
+  dropExtension . dropExtension
+
+isMigrationFile :: FilePath -> Bool
+isMigrationFile p =
+  isSuffixOf ".up.sql" p || isSuffixOf ".down.sql" p
+
+isUp :: FilePath -> Bool
+isUp =
+  isMigrationType "up"
+
+isMigrationType :: String -> FilePath -> Bool
+isMigrationType t p =
+  (takeExtension . takeExtension $ p) == t
+
+mkmigration :: [FilePath] -> Either Text [Migration]
+mkmigration paths =
+  mapM (\group -> case group of
+    a : _ : [] -> Right . File.migration $ unsuffix a
+    a : [] ->  Right $ (if isUp a then File.up else File.down) (unsuffix a)
+    _ -> Left . pack $ "Duplicate prefix detected in: " ++ (intercalate "," group)
+  ) (groupBy (\a b -> unsuffix a == unsuffix b) paths)
diff --git a/src/Database/Migrate/Migration/File.hs b/src/Database/Migrate/Migration/File.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Migration/File.hs
@@ -0,0 +1,19 @@
+module Database.Migrate.Migration.File (
+  migration
+, up
+, down
+) where
+
+import Database.Migrate.Migration
+
+migration :: MigrationId -> FilePath -> FilePath -> Migration
+migration mid up' down' =
+  Migration mid (DdlFile up') (DdlFile down')
+
+up :: MigrationId -> FilePath -> Migration
+up mid up' =
+  Migration mid (DdlFile up') NoOp
+
+down :: MigrationId -> FilePath -> Migration
+down mid down' =
+  Migration mid NoOp (DdlFile down')
diff --git a/src/Database/Migrate/Migration/FileInferred.hs b/src/Database/Migrate/Migration/FileInferred.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Migration/FileInferred.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Database.Migrate.Migration.FileInferred (
+  migration
+, up
+, down
+, directory
+) where
+
+import           Data.List (isSuffixOf, intercalate, groupBy)
+import           Data.Text (Text, pack)
+
+import           Database.Migrate.Migration
+import qualified Database.Migrate.Migration.File         as File
+import qualified Database.Migrate.Migration.FileStandard as FileStandard
+import           System.FilePath
+import           System.Directory
+
+directory :: FilePath -> IO (Either Text [Migration])
+directory path = do
+  changes <- (filter (\p -> isSuffixOf ".up.sql" p || isSuffixOf ".down.sql" p)) `fmap` getDirectoryContents path
+  return $ mapM (\group ->
+    case group of
+      a : _ : [] -> (Right $ migration (dropExtension . dropExtension $ a))
+      a : [] -> (Right $ (if ((takeExtension . takeExtension $ a) == "up") then File.up else File.down) (infer a) a)
+      _ -> (Left . pack $ "Duplicate prefix detected in: " ++ (intercalate "," group))
+    ) $ groupBy (\a b -> (dropExtension . dropExtension $ a) == (dropExtension . dropExtension $ b)) changes
+
+migration :: FilePath -> Migration
+migration prefix =
+  FileStandard.migration (infer prefix) prefix
+
+up :: FilePath -> Migration
+up prefix =
+  FileStandard.up (infer prefix) prefix
+
+down :: FilePath -> Migration
+down prefix =
+  FileStandard.down (infer prefix) prefix
+
+infer :: FilePath -> MigrationId
+infer =
+  pack . dropExtensions . last . splitPath
diff --git a/src/Database/Migrate/Migration/FileStandard.hs b/src/Database/Migrate/Migration/FileStandard.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Migration/FileStandard.hs
@@ -0,0 +1,21 @@
+module Database.Migrate.Migration.FileStandard (
+  migration
+, up
+, down
+) where
+
+import           Database.Migrate.Migration
+import qualified Database.Migrate.Migration.File as File
+import           System.FilePath
+
+migration :: MigrationId -> FilePath -> Migration
+migration mid prefix =
+  File.migration mid (prefix <.> "up.ddl") (prefix <.> "down.ddl")
+
+up :: MigrationId -> FilePath -> Migration
+up mid prefix =
+  File.up mid (prefix <.> ".up.ddl")
+
+down :: MigrationId -> FilePath -> Migration
+down mid prefix =
+  File.down mid (prefix <.> "down.ddl")
diff --git a/src/Database/Migrate/PostgreSQL.hs b/src/Database/Migrate/PostgreSQL.hs
--- a/src/Database/Migrate/PostgreSQL.hs
+++ b/src/Database/Migrate/PostgreSQL.hs
@@ -1,90 +1,133 @@
-{-#LANGUAGE OverloadedStrings #-}
-module Database.Migrate.PostgreSQL where
+{-# LANGUAGE OverloadedStrings, LiberalTypeSynonyms #-}
+module Database.Migrate.PostgreSQL (
+  psqlMain
+, migrate
+) where
 
-import Database.Migrate.Data
-import Database.Migrate.Kernel
+import           Control.Lens                    ((^.))
+import           Control.Monad                   (void, forM_)
+import           Control.Monad.Trans.Reader
+import           Control.Monad.IO.Class
 
-import Control.Exception (SomeException(..), handle)
-import Control.Monad
-import Control.Monad.IO.Class
+import qualified Data.Set as S
+import           Data.String (IsString(..))
+import           Data.Text                       hiding (length, foldr, filter)
+import           Data.Time
 
-import Data.Maybe
-import Data.Text hiding (filter, reverse, find, null)
-import Data.String (IsString(..))
+import           Database.PostgreSQL.Simple
+import           Database.Migrate.Migration
 
-import Database.PostgreSQL.Simple
-import Database.PostgreSQL.Simple.FromField
-import Database.PostgreSQL.Simple.ToField
+import           System.IO
+import           System.FilePath
 
-instance FromField MigrationId where
-  fromField f m = fmap MigrationId $ fromField f m
 
-instance ToField MigrationId where
-  toField (MigrationId m) = toField m
+data DbRead = DbRead { getConnection :: Connection, getDbName :: DbName,  getBase :: FilePath }
+type DbName = Text
+type Db a = ReaderT DbRead IO a
 
-data PsqlConnectInfo = PsqlConnectInfo
+psqlMain :: IO ()
+psqlMain = putStrLn "hello"
 
-psqlMigrateDatabase :: MigrateDatabase IO Connection
-psqlMigrateDatabase =
-  MigrateDatabase {
-    current = connection >>= \c ->
-     liftIO (query_ c "SELECT TRUE FROM pg_tables WHERE schemaname='public' AND tablename = 'migration_info'") >>= \r ->
-      return (maybe False fromOnly (listToMaybe r)) >>= \rr ->
-      if rr
-        then liftIO (fmap Initialized (fmap (fmap fromOnly) (query_ c "SELECT migration FROM migration_info")))
-        else return NotInitialized
-  , initialize = connection >>= \c -> liftIO . void $
-      execute_ c "CREATE TABLE IF NOT EXISTS migration_info (migration VARCHAR(50) PRIMARY KEY)"
-  , runSql = \sql -> connection >>= \c ->
-     liftIO . void $ execute_ c (fromString . unpack $ sql)
-  , recordInstall = \m -> connection >>= \c ->
-     liftIO . void $ (begin c >> execute c "INSERT INTO migration_info (migration) VALUES (?)" (Only $ migrationId m) >> commit c)
-  , recordRollback = \m -> connection >>= \c ->
-     liftIO . void $ (begin c >> execute c "DELETE FROM migration_info WHERE migration = ?" (Only $ migrationId m) >> commit c)
-  }
+migrate :: DbName -> Connection -> FilePath -> [Migration] -> IO ()
+migrate n c b migrations =
+  runReaderT (run_ history >> run_ versions >> migrate' migrations) (DbRead c n b)
 
-{-
-  testconn =  connection >>= \c ->  query_ c "SELECT TRUE" >>= \r -> return $ maybe False fromOnly (listToMaybe r)
+migrate' :: [Migration] -> Db ()
+migrate' migrations = do
 
-  initialize = connection >>= \c -> void $ execute_ c "CREATE TABLE IF NOT EXISTS MIGRATION_INFO (MIGRATION VARCHAR(50) PRIMARY KEY)"
-  initialized = connection >>= \c -> query_ c "SELECT TRUE FROM pg_tables WHERE schemaname='public' AND tablename = MIGRATION_INFO" >>= \r -> return $ maybe False fromOnly (listToMaybe r)
-  runMigration = runall
-  getMigrations c = fmap (fmap fromOnly) (query_ c "SELECT MIGRATION FROM MIGRATION_INFO")
+  installed <- current
+  let nu = missing migrations installed
+  forM_ nu $ \m -> do
+    up m
+    liftIO . putStrLn $ "Installed <" ++ (unpack . _migrationId $ m) ++ ">"
 
+history :: Query
+history =
+  "CREATE TABLE IF NOT EXISTS migration_history (db VARCHAR(50), migration VARCHAR(50), action CHARACTER VARYING(20), at TIMESTAMPTZ, sql TEXT)"
 
-migratePostgres :: Connection -> FilePath -> (String -> IO ()) -> IO () -> IO ()
-migratePostgres c path logger bomb = do
-   initialize c
-   ems <- runEitherT $ find path
-   case ems of
-     Left e -> logger e >> bomb
-     Right ms -> runEitherT (latest c ms) >>= \er ->
-       case er of
-         Left (Context s f m r) ->
-           forM_ s (\mid -> logger ("migration:applied: " ++ (unpack . extract $ mid))) >>
-           logger ("migration:failed:" ++ (unpack . extract $ f) ++ ":" ++ unpack m) >>
-           logger ("migration:rolledback:" ++ show r) >>
-           bomb
-         Right mids -> if null mids
-                         then logger "migration:up-to-date"
-                         else forM_ mids $ \mid -> logger $ "migration:applied: " ++ (unpack . extract $ mid)
+versions :: Query
+versions =
+  "CREATE TABLE IF NOT EXISTS migration_versions (db VARCHAR(50), migration VARCHAR(50) PRIMARY KEY)"
 
-record :: Connection -> MigrationId -> IO ()
-record conn mid = void $ execute conn "INSERT INTO MIGRATION_INFO VALUES (?)" (Only mid)
+install :: Query
+install =
+  "INSERT INTO migration_versions (db, migration) VALUES (?, ?)"
 
-runall :: Connection -> (Migration -> Ddl) -> [Migration] -> MigrationResultT IO [MigrationId]
-runall c f ms =
-  liftIO (begin c) >>
-    foldM (\rs m ->
-             EitherT $
-               do e <- runEitherT (saferun c f m)
-                  case e of
-                    Left emsg -> rollback c >> (return . Left $ Context (reverse rs) (migration m) emsg True)
-                    Right r -> return . Right $ r:rs) [] ms >>= \result -> liftIO (commit c) >> return (reverse result)
+uninstall :: Query
+uninstall =
+  "DELETE FROM migration_versions (db, migration) WHERE db = ? AND migration = ?"
 
-saferun :: Connection -> (Migration -> Ddl) -> Migration -> EitherT Text IO MigrationId
-saferun c f m = EitherT $ handle (\e -> return (Left (pack . show $ (e :: SomeException)))) (fmap Right $ run c f m)
+addhistory :: Query
+addhistory =
+  "INSERT INTO migration_history (db, migration, action, at, sql) VALUES (?, ?, ?, ?, ?)"
 
-run :: Connection -> (Migration -> Ddl) -> Migration -> IO MigrationId
-run c f m = execute_ c (fromString . unpack $ f m) >> record c (migration m) >> return (migration m)
--}
+currentversions :: Query
+currentversions =
+  "SELECT migration FROM migration_versions WHERE db = ?"
+
+current :: Db [MigrationId]
+current = do
+  n <- ask >>= return . getDbName
+  unonly $ list currentversions (Only n)
+
+up :: Migration -> Db ()
+up =
+  change "up" _upChange
+
+down :: Migration -> Db ()
+down =
+  change "down" _downChange
+
+change :: Text -> (Migration -> Change) -> Migration -> Db ()
+change mode getChange m = do
+  t <- now
+  n <- ask >>= return . getDbName
+  ch <- raw . getChange $ m
+  run addhistory (n, m^.migrationId, mode, t, ch)
+  run install (n, m^.migrationId)
+  run_ . mkquery $ ch
+
+run :: ToRow a => Query -> a -> Db ()
+run q a = do
+  c <- ask >>= return . getConnection
+  liftIO . void $ execute c q a
+
+run_ :: Query -> Db ()
+run_ q = do
+  c <- ask >>= return . getConnection
+  liftIO . void $ execute_ c q
+
+list :: (ToRow a, FromRow b) => Query -> a -> Db [b]
+list q a = do
+  c <- ask >>= return . getConnection
+  liftIO $ query c q a
+
+now :: Db UTCTime
+now = liftIO getCurrentTime
+
+mkquery :: Text -> Query
+mkquery = fromString . unpack
+
+raw :: Change -> Db Text
+raw (Ddl q) = return q
+raw (Dud msg) = error . unpack $ msg -- FIX
+raw NoOp = return "select true;"
+raw (DdlFile q) = do
+  b <- ask >>= return . getBase
+  liftIO $ readFile' (b </> q) >>= return . pack
+
+readFile' :: FilePath -> IO String
+readFile' p = withFile p ReadMode hGetContents'
+
+hGetContents' :: Handle -> IO String
+hGetContents' h = hGetContents h >>= \s -> length s `seq` return s
+
+unonly :: Db [Only a] -> Db [a]
+unonly = fmap (fmap (\(Only a) -> a))
+
+missing :: [Migration] -> [MigrationId] -> [Migration]
+missing migrations applied =
+  let available = foldr (S.insert . _migrationId) S.empty migrations
+      installed = S.fromList applied
+      torun = S.difference available installed
+   in filter (\m -> S.member (_migrationId m) torun) migrations