diff --git a/database-migrate.cabal b/database-migrate.cabal
--- a/database-migrate.cabal
+++ b/database-migrate.cabal
@@ -1,11 +1,11 @@
 Name:               database-migrate
-Version:            0.0.3
+Version:            0.1.0
 License:            BSD3
 License-File:       LICENSE
 Author:             Mark Hibberd <mark@hibberd.id.au>
 Maintainer:         Mark Hibberd <mark@hibberd.id.au>
 Copyright:          (c) 2012 Mark Hibberd
-Synopsis:           Database versioning and migration
+Synopsis:           Database versioning and migration (experimental)
 Category:           Database
 Homepage:           https://github.com/markhibberd/database-migrate
 Bug-reports:           https://github.com/markhibberd/database-migrate/issues
@@ -29,17 +29,17 @@
 
 Library
   Build-Depends:
-                    base                            >= 3          && < 5
-                    , text                          >= 0.11       && < 0.12
-                    , directory                     >= 1.0        && < 2.0
-                    , filepath                      >= 1.0        && < 2.0
-                    , bytestring                    >= 0.9        && < 0.10
-                    , time                          >= 1.0        && < 2.0
+                    base                            >= 3 && < 5
+                    , text                          >= 0.11
+                    , directory                     >= 1.0
+                    , filepath                      >= 1.0
+                    , bytestring                    >= 0.9
+                    , time                          >= 1.0
                     , postgresql-simple             == 0.1.4.3
-                    , containers                    >= 0.4        && < 0.5
-                    , either                        >= 3.0.2      && < 4.0
-                    , transformers                  >= 0.2        && < 0.4
-                    , cmdargs                       >= 0.9.3      && < 1.0.0
+                    , containers                    >= 0.4
+                    , either                        >= 3.0.2
+                    , transformers                  >= 0.2
+                    , cmdargs                       >= 0.9.3
 
   GHC-Options:
                     -Wall -fno-warn-orphans
@@ -49,10 +49,8 @@
 
   Exposed-Modules:
                     Database.Migrate
+                    Database.Migrate.Data
+                    Database.Migrate.Kernel
+                    Database.Migrate.Loader
                     Database.Migrate.Main
-                    Database.Migrate.Core
                     Database.Migrate.PostgreSQL
-
-  Extensions:
-                    MultiParamTypeClasses
-                    OverloadedStrings
diff --git a/src/Database/Migrate.hs b/src/Database/Migrate.hs
--- a/src/Database/Migrate.hs
+++ b/src/Database/Migrate.hs
@@ -16,9 +16,8 @@
 --
 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.Core as X
--- import Database.Migrate.MySQL as X
 import Database.Migrate.PostgreSQL as X
-
-
diff --git a/src/Database/Migrate/Core.hs b/src/Database/Migrate/Core.hs
deleted file mode 100644
--- a/src/Database/Migrate/Core.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-#LANGUAGE OverloadedStrings, ScopedTypeVariables#-}
-module Database.Migrate.Core where
-
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Either
-
-import qualified Data.Set as S
-import Data.List (sort)
-import Data.Text hiding (foldr, filter, reverse, length)
-
-import System.FilePath
-import System.Directory
-import System.IO
-
-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)
-
-type Ddl = Text
-
-data Migration =
-  Migration {
-      migration :: MigrationId
-    , up :: Text
-    , down :: Text
-    , upsource :: Maybe FilePath
-    , downsource :: Maybe FilePath
-    } deriving (Eq, Show)
-
-instance Ord Migration where
-  compare a b = compare (migration a) (migration b)
-
-data Context = Context {
-    succeeded :: [MigrationId]
-  , failed :: MigrationId
-  , msg :: Text
-  , rolledback :: Bool
-  } deriving (Eq, Show)
-
-type MigrationResultT = EitherT Context
-
-class Monad m => MigrateDatabase m c where
-  initialize :: c -> m ()
-  runMigrations :: c -> (Migration -> Ddl) -> [Migration] -> MigrationResultT m [MigrationId]
-  getMigrations :: c -> m [MigrationId]
-
-pick :: [Migration] -> [MigrationId] -> [Migration]
-pick ms ids =
-  let available = foldr (S.insert . migration) S.empty ms
-      installed = S.fromList ids
-      torun = S.difference available installed
-   in filter (\m -> S.member (migration m) torun) ms
-
-latest :: MigrateDatabase m c => c -> [Migration] -> MigrationResultT m [MigrationId]
-latest c migrations =
-  lift (getMigrations c) >>= \installed -> runMigrations c up (pick migrations installed)
-
-find :: FilePath -> EitherT String IO [Migration]
-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) (Just $ b </> p <.> "up.sql") (Just $ b </> p <.> "down.sql"))))
-
-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/Data.hs b/src/Database/Migrate/Data.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Data.hs
@@ -0,0 +1,73 @@
+{-#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
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Kernel.hs
@@ -0,0 +1,52 @@
+{-#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
new file mode 100644
--- /dev/null
+++ b/src/Database/Migrate/Loader.hs
@@ -0,0 +1,35 @@
+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
--- a/src/Database/Migrate/Main.hs
+++ b/src/Database/Migrate/Main.hs
@@ -1,79 +1,128 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Database.Migrate.Main (defaultMain) where
+module Database.Migrate.Main (defaultMain, defaultMain') where
 
---import qualified Paths_database_migrate as Program (version)
+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.PostgreSQL.Simple
+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: migrate [-v|--verbose] [-r|--dry-run] [-t|--test-run] [-a|--auto] [-s|--scripts DIR]"
-  , "               [-h|--host HOSTNAME] [-p|--port PORTNUMBER] [-u|--user USER]"
-  , "               [-P|--password PASSWORD] [-d|--db DATABASE] [-g|--postgres] [-m|--mysql] [VERSION]"
-  , "       migrate -h|--help"
-  , "       migrate -V|--version"
+    "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 {
-    printhelp :: Bool
-  , printversion :: Bool
-  , dry :: Bool
-  , test :: Bool
-  , auto :: Bool
-  , postgres :: Bool
-  , mysql :: Bool
-  , version :: Maybe String
-  , scripts :: String
+    adbmode :: DbMode
+  , adry :: Bool
+  , averbose :: Bool
+  , ascripts :: String
+  , aversion :: Maybe String
   } deriving (Eq, Show)
 
 defaultArguments cwd = Arguments {
-    printhelp = False
-  , printversion = False
-  , dry = False
-  , test = False
-  , auto = False
-  , postgres = False
-  , mysql = False
-  , version = Nothing
-  , scripts = cwd
+    adbmode = HelpMode
+  , adry = False
+  , averbose = False
+  , ascripts = cwd </> "migrations"
+  , aversion = Nothing
   }
 
-migratemode cwd =
-  mode "migrate" (defaultArguments cwd) "" (flagArg (\v a -> Right $ a { version = Just v }) "VERSION") [
-      flagNone [ "h", "help" ]     (\a -> a { printhelp = True })    ""
-    , flagNone [ "V", "version" ]  (\a -> a { printversion = True }) ""
-    , flagNone [ "r", "dry-run" ]  (\a -> a { dry = True })          ""
-    , flagNone [ "g", "postgres" ]  (\a -> a { postgres = True })    ""
-    , flagNone [ "m", "mysql" ]  (\a -> a { postgres = True })    ""
-    ]
-
-defaultMain =
-  getCurrentDirectory >>= \cwd -> processArgs (migratemode cwd) >>= run
+defaultMain :: Migrations -> MigrateDatabase IO c -> IO c -> IO ()
+defaultMain migrationstore db connector = getArgs >>= defaultMain' migrationstore db connector
 
-run args
-  | printhelp args      = mapM_ putStrLn usage
-  | printversion args   = putStrLn $ "migrate " ++ "showVersion Program.version"
-  | otherwise           = migrate args
+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
 
-bomb msg =
-  putStrLn msg >> exitFailure
+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 " ++ 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
 
-migrate args =
-  case (postgres args, mysql args) of
-    (False, False) -> bomb "Must specify exactly one of -p or -m for database selection, specified none."
-    (True, True) -> bomb "Must specify exactly one of -p or -m for database selection, specified two."
-    (True, _) -> runpostgres args
-    (_, True) -> runmysql args
+bomb failwith =
+  putStrLn failwith >> exitFailure
 
-runmysql _  =
-  bomb "Not implemented yet."
+upmode :: MigrateDatabase m c -> Migrate c m ()
+upmode = undefined
 
-runpostgres args =
-  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/PostgreSQL.hs b/src/Database/Migrate/PostgreSQL.hs
--- a/src/Database/Migrate/PostgreSQL.hs
+++ b/src/Database/Migrate/PostgreSQL.hs
@@ -1,18 +1,20 @@
 {-#LANGUAGE OverloadedStrings #-}
 module Database.Migrate.PostgreSQL where
 
+import Database.Migrate.Data
+import Database.Migrate.Kernel
+
 import Control.Exception (SomeException(..), handle)
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Either
 
+import Data.Maybe
 import Data.Text hiding (filter, reverse, find, null)
 import Data.String (IsString(..))
 
 import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.FromField
 import Database.PostgreSQL.Simple.ToField
-import Database.Migrate.Core
 
 instance FromField MigrationId where
   fromField f m = fmap MigrationId $ fromField f m
@@ -20,9 +22,33 @@
 instance ToField MigrationId where
   toField (MigrationId m) = toField m
 
-instance MigrateDatabase IO Connection where
-  initialize c = void $ execute_ c "CREATE TABLE IF NOT EXISTS MIGRATION_INFO (MIGRATION VARCHAR(50) PRIMARY KEY)"
-  runMigrations = runall
+data PsqlConnectInfo = PsqlConnectInfo
+
+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)
+  }
+
+{-
+  testconn =  connection >>= \c ->  query_ c "SELECT TRUE" >>= \r -> return $ maybe False fromOnly (listToMaybe r)
+
+  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")
 
 
@@ -61,3 +87,4 @@
 
 run :: Connection -> (Migration -> Ddl) -> Migration -> IO MigrationId
 run c f m = execute_ c (fromString . unpack $ f m) >> record c (migration m) >> return (migration m)
+-}