diff --git a/Database/Connection.hs b/Database/Connection.hs
deleted file mode 100644
--- a/Database/Connection.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-module Database.Connection where
-
-import Control.Monad.IO.Class (liftIO, MonadIO)
-import Control.Concurrent
-import Control.Exception (finally)
-import Database.PostgreSQL.Simple
-import Network.URI
-import System.IO.Unsafe
-
-{-# NOINLINE conns #-}
-conns :: Chan Connection
-conns = unsafePerformIO $ newChan
-
-createConnection :: ConnectInfo -> IO ()
-createConnection config = connect config >>= writeChan conns
-
-parseDbURL :: String -> ConnectInfo
-parseDbURL uri = case mdbURI of
-    Nothing -> defaultConnectInfo
-    Just dbURI | uriScheme dbURI == "postgres:" ->
-      let auth = uriAuthority dbURI
-      in ConnectInfo { connectPort = toPort auth
-                  , connectHost = toHostname auth
-                  , connectUser = toUsername auth
-                  , connectPassword = toPassword auth
-                  , connectDatabase = toDatabase . uriPath $ dbURI}
-      | otherwise -> defaultConnectInfo
-  where mdbURI = parseURI uri
-        toPort (Just (URIAuth _ _ "")) = 5432
-        toPort (Just (URIAuth _ _ (':':p))) = read p
-        toPort _ = 5432
-        toHostname (Just (URIAuth _ h _)) = h
-        toHostname _ = "localhost"
-        toUsername (Just (URIAuth ua _ _)) = takeWhile (\x -> x /= ':' && x /= '@') ua
-        toUsername Nothing = ""
-        toPassword (Just (URIAuth ua _ _)) = case dropWhile (/= ':') ua of
-                                               (':':password) -> takeWhile (/= '@') password
-                                               _ -> ""
-        toPassword Nothing = ""
-        toDatabase ('/':db) = db
-        toDatabase _ = ""
-
-withConnection :: MonadIO m => (Connection -> IO b) -> m b
-withConnection func = liftIO $ do
-  conn <- readChan conns
-  finally (func conn) (writeChan conns conn)
-
diff --git a/Database/Migrations.hs b/Database/Migrations.hs
deleted file mode 100644
--- a/Database/Migrations.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module Database.Migrations
-  ( defaultMain
-  , module Database.Sequel
-  ) where
-
-import Prelude hiding (catch)
-import Control.Exception
-import Database.Connection
-import Database.Sequel
-import Database.PostgreSQL.Simple
-import System.Environment
-
-defaultMain :: Sequel () -> Sequel () -> IO ()
-defaultMain up down = do
-  dbURI <- catch (getEnv "DATABASE_URL")
-            (const $ return "postgres://" :: SomeException -> IO String)
-  createConnection $ parseDbURL dbURI
-
-  args <- getArgs
-  case args of
-    "--rollback":_ -> runSequel down >>= withConnection . (flip execute_)
-    _ -> runSequel up >>= withConnection . (flip execute_)
-  return ()
diff --git a/Database/PostgreSQL/Connection.hs b/Database/PostgreSQL/Connection.hs
new file mode 100644
--- /dev/null
+++ b/Database/PostgreSQL/Connection.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Database.PostgreSQL.Connection where
+
+import Data.Pool
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource
+import Database.PostgreSQL.Simple
+import Network.URI
+import System.IO.Unsafe
+import System.Environment
+
+{-# NOINLINE conns #-}
+conns :: Pool Connection
+conns = unsafePerformIO $ do
+  dbUrl <- getEnv "DATABASE_URL"
+  let creator = createConnection $ parseDbURL dbUrl
+  createPool creator
+             (\c -> rollback c >> close c)
+             1
+             (fromInteger 60)
+             20
+
+createConnection :: ConnectInfo -> IO Connection
+createConnection config = connect config
+
+parseDbURL :: String -> ConnectInfo
+parseDbURL uri = case mdbURI of
+    Nothing -> defaultConnectInfo
+    Just dbURI | uriScheme dbURI == "postgres:" ->
+      let auth = uriAuthority dbURI
+      in ConnectInfo { connectPort = toPort auth
+                  , connectHost = toHostname auth
+                  , connectUser = toUsername auth
+                  , connectPassword = toPassword auth
+                  , connectDatabase = toDatabase . uriPath $ dbURI}
+      | otherwise -> defaultConnectInfo
+  where mdbURI = parseURI uri
+        toPort (Just (URIAuth _ _ "")) = 5432
+        toPort (Just (URIAuth _ _ (':':p))) = read p
+        toPort _ = 5432
+        toHostname (Just (URIAuth _ h _)) = h
+        toHostname _ = "localhost"
+        toUsername (Just (URIAuth ua _ _)) = takeWhile (\x -> x /= ':' && x /= '@') ua
+        toUsername Nothing = ""
+        toPassword (Just (URIAuth ua _ _)) = case dropWhile (/= ':') ua of
+                                               (':':password) -> takeWhile (/= '@') password
+                                               _ -> ""
+        toPassword Nothing = ""
+        toDatabase ('/':db) = db
+        toDatabase _ = ""
+
+withConnection :: (MonadIO m, MonadBaseControl IO m) => (Connection -> m b) -> m b
+withConnection func = withResource conns $ \conn -> do
+  liftIO $ begin conn
+  res <- func conn
+  liftIO $ commit conn
+  return res
+
diff --git a/Database/PostgreSQL/Migrations.hs b/Database/PostgreSQL/Migrations.hs
new file mode 100644
--- /dev/null
+++ b/Database/PostgreSQL/Migrations.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Database.PostgreSQL.Migrations
+  ( runDb, dbUp, dbDown, initDb
+  , module Database.PostgreSQL.Sequel
+  ) where
+
+import Prelude
+import Control.Monad.IO.Class (liftIO)
+import Database.PostgreSQL.Connection
+import Database.PostgreSQL.Sequel
+import Database.PostgreSQL.Simple
+import Web.Simple.Migrations
+
+runDb :: Sequel a -> IO a
+runDb act = withConnection $ \conn -> runSequel act conn
+
+dbUp :: Sequel a -> Migration
+dbUp act version name = runDb $ do
+  (Only count:_) <-
+    sqlQuery "select count(version) from schema_migrations where version = ?"
+              [version]
+  if (count :: Int) > 0 then
+    return False
+    else do
+          liftIO $ putStrLn $
+            "=== Running migration: " ++ name ++ " (" ++ version ++ ")"
+          act
+          sqlExecute "insert into schema_migrations (version) values(?)"
+                     (Only version)
+          return True
+
+dbDown :: Sequel a -> Migration
+dbDown act version name = runDb $ do
+  (Only count:_) <-
+    sqlQuery "select count(version) from schema_migrations where version = ?"
+              [version]
+  if (count :: Int) == 0 then
+    return False
+    else do
+          liftIO $ putStrLn $
+            "=== Rolling back: " ++ name ++ " (" ++ version ++ ")"
+          act
+          sqlExecute "delete from schema_migrations where version = ?"
+                     (Only version)
+          return True
+
+initDb :: Migration
+initDb _ _ = runDb $ do
+  (Only count:_) <- sqlQuery "select count(*) from pg_class where relname = ?"
+                      (Only ("schema_migrations" :: String))
+  if (count :: Int) /= 0 then
+    return False
+    else do
+          liftIO $ putStrLn "Creating table `schema_migrations`"
+          create_table "schema_migrations" $
+            column "version" string [UNIQUE]
+          return True
+
diff --git a/Database/PostgreSQL/Models.hs b/Database/PostgreSQL/Models.hs
--- a/Database/PostgreSQL/Models.hs
+++ b/Database/PostgreSQL/Models.hs
@@ -116,6 +116,20 @@
           tName = tableName model
           cols = concat $ intersperse ", " $ map (++ " =?") (columns tName)
 
+  destroy :: p -> Connection -> IO Bool
+  destroy model conn = do
+    case primaryKey model of
+      Nothing -> return False
+      Just pkey -> do
+        fmap (> 0) $ execute conn template (Only pkey)
+    where template = fromString $ concat
+            [ "delete from "
+            , fromTableName tName
+            , " where "
+            , primaryKeyName tName
+            , " = ?;"]
+          tName = tableName model
+
   -- | Retrieves the single model corresponding to the given primary key
   find :: TableName p -> PrimaryKey p -> Connection -> IO (Maybe p)
   find tn = findFirst tn (primaryKeyName tn)
diff --git a/Database/PostgreSQL/Sequel.hs b/Database/PostgreSQL/Sequel.hs
new file mode 100644
--- /dev/null
+++ b/Database/PostgreSQL/Sequel.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Database.PostgreSQL.Sequel where
+
+import Database.PostgreSQL.Simple
+import Control.Monad.Identity
+import Control.Monad.State
+import Data.List
+import Data.String
+
+data Sequel a = Sequel { runSequel :: Connection -> IO a }
+
+instance Monad Sequel where
+  return a = Sequel $ const $ return a
+  (>>=) (Sequel run) f = Sequel $ \conn ->
+    run conn >>= \res -> runSequel (f res) conn
+
+instance MonadIO Sequel where
+  liftIO = Sequel . const
+
+drop_table :: String -> Sequel ()
+drop_table name = sqlExecute_ (fromString $ "DROP TABLE " ++ name ++ ";")
+
+create_table :: String -> CreateTable a -> Sequel ()
+create_table name block = do
+  let blk = runCreateTable block
+  let execStr = fromString $ concat $
+            [ "CREATE TABLE "
+            , name
+            , " (\n"
+            , blk
+            , "\n);"]
+  sqlExecute_ execStr
+
+type ColumnType = String
+
+serial :: ColumnType
+serial = "serial"
+
+integer :: ColumnType
+integer = "integer"
+
+time :: ColumnType
+time = "time"
+
+timestamp :: ColumnType
+timestamp = "timestamptz"
+
+varchar :: Integer -> ColumnType
+varchar size = "varchar(" ++ (show size) ++ ")"
+
+string :: ColumnType
+string = varchar 255
+
+text :: ColumnType
+text = "text"
+
+boolean :: ColumnType
+boolean = "boolean"
+
+data ColumnConstraint = NOT_NULL
+                      | UNIQUE
+                      | PRIMARY_KEY
+                      | DEFAULT String
+                      | REFERENCES String String
+
+stringifyConstraint :: ColumnConstraint -> String
+stringifyConstraint NOT_NULL = "NOT NULL"
+stringifyConstraint UNIQUE = "UNIQUE"
+stringifyConstraint PRIMARY_KEY = "PRIMARY KEY"
+stringifyConstraint (DEFAULT str) = "DEFAULT " ++ str
+stringifyConstraint (REFERENCES table col) =
+  "REFERENCES " ++ table ++ "(" ++ col ++ ")"
+
+drop_column :: String -> String -> Sequel ()
+drop_column tableName colName = sqlExecute_ $ fromString $ concat
+    ["ALTER TABLE "
+    , tableName
+    , " DROP COLUMN "
+    , colName
+    , ";"]
+
+add_column :: String -> String -> ColumnType -> [ColumnConstraint] -> Sequel ()
+add_column tableName colName colType ctrs = sqlExecute_ $ fromString $ concat
+  [ "ALTER TABLE "
+  , tableName
+  , " ADD COLUMN "
+  , colName
+  , " "
+  , colType
+  , " "
+  , concat $ intersperse " " (map stringifyConstraint ctrs), ";"]
+
+rename_column :: String -> String -> String -> Sequel ()
+rename_column tableName fromName toName = sqlExecute_ $ fromString $ concat
+  [ "ALTER TABLE "
+  , tableName
+  , " RENAME COLUMN "
+  , fromName
+  , " TO "
+  , toName, ";"]
+
+type CreateTable = StateT [(ColumnType, String, [ColumnConstraint])] Identity
+
+runCreateTable :: CreateTable a -> String
+runCreateTable ct = runIdentity $ do
+  (_, cols) <- runStateT ct []
+  let colStrs = map
+        (\(t, name, crts) ->
+            "  " ++ name ++ " " ++ t ++ " " ++
+            (concat $ intersperse " " (map stringifyConstraint crts))
+        ) cols
+  return $ concat $ intersperse ",\n" (reverse colStrs)
+
+column :: String -> ColumnType -> [ColumnConstraint] -> CreateTable ()
+column colName colType constraints = do
+  modify $ \cols -> (colType, colName, constraints):cols
+
+sqlQuery :: (ToRow q, FromRow r) => Query -> q -> Sequel [r]
+sqlQuery myq params = Sequel $ \conn -> query conn myq params
+
+sqlQuery_ :: FromRow r => Query -> Sequel [r]
+sqlQuery_ myq = Sequel $ \conn -> query_ conn myq
+
+sqlExecute :: ToRow q => Query -> q -> Sequel ()
+sqlExecute myq params = Sequel $ \conn -> execute conn myq params >> return ()
+
+sqlExecute_ :: Query -> Sequel ()
+sqlExecute_ myq = Sequel $ \conn -> execute_ conn myq >> return ()
+
diff --git a/Database/Sequel.hs b/Database/Sequel.hs
deleted file mode 100644
--- a/Database/Sequel.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-module Database.Sequel where
-
-import Control.Monad.State
-import Data.List
-import Data.String
-
-type Sequel = StateT String IO
-
-runSequel :: IsString s => Sequel a -> IO s
-runSequel sql = fmap (fromString . snd) $ runStateT sql ""
-
-append :: String -> Sequel ()
-append str1 = modify $ \str0 -> concat $
-  [ str0
-  , "\n\n"
-  , str1]
-
-drop_table :: String -> Sequel ()
-drop_table name = append $ "DROP TABLE " ++ name ++ ";"
-
-create_table :: String -> CreateTable a -> Sequel ()
-create_table name block = do
-  blk <- runCreateTable $ do
-    block
-  append $ concat $
-    [ "CREATE TABLE " ++ name ++ " (\n"
-    , blk
-    , "\n);"]
-
-type ColumnType = String
-
-serial :: ColumnType
-serial = "serial"
-
-integer :: ColumnType
-integer = "integer"
-
-time :: ColumnType
-time = "time"
-
-varchar :: Integer -> ColumnType
-varchar size = "varchar(" ++ (show size) ++ ")"
-
-string :: ColumnType
-string = varchar 255
-
-text :: ColumnType
-text = "text"
-
-boolean :: ColumnType
-boolean = "boolean"
-
-data ColumnConstraint = NOT_NULL
-                      | UNIQUE
-                      | PRIMARY_KEY
-                      | DEFAULT String
-                      | REFERENCES String String
-
-stringifyConstraint :: ColumnConstraint -> String
-stringifyConstraint NOT_NULL = "NOT NULL"
-stringifyConstraint UNIQUE = "UNIQUE"
-stringifyConstraint PRIMARY_KEY = "PRIMARY KEY"
-stringifyConstraint (DEFAULT str) = "DEFAULT " ++ str
-stringifyConstraint (REFERENCES table col) =
-  "REFERENCES " ++ table ++ "(" ++ col ++ ")"
-
-drop_column :: String -> String -> Sequel ()
-drop_column tableName colName = append $ concat $
-  [ "ALTER TABLE "
-  , tableName
-  , " DROP COLUMN "
-  , colName, ";"]
-
-add_column :: String -> String -> ColumnType -> [ColumnConstraint] -> Sequel ()
-add_column tableName colName colType ctrs = append $ concat $
-  [ "ALTER TABLE "
-  , tableName
-  , " ADD COLUMN "
-  , colName
-  , " "
-  , colType
-  , " "
-  , concat $ intersperse " " (map stringifyConstraint ctrs), ";"]
-
-rename_column :: String -> String -> String -> Sequel ()
-rename_column tableName fromName toName = append $ concat $
-  [ "ALTER TABLE "
-  , tableName
-  , " RENAME COLUMN "
-  , fromName
-  , " TO "
-  , toName
-  , ";"]
-
-type CreateTable = StateT [(ColumnType, String, [ColumnConstraint])] Sequel
-
-runCreateTable :: CreateTable a -> Sequel String
-runCreateTable ct = do
-  (_, cols) <- runStateT ct []
-  let colStrs = map
-        (\(t, name, crts) ->
-            "  " ++ name ++ " " ++ t ++ " " ++
-            (concat $ intersperse " " (map stringifyConstraint crts))
-        ) cols
-  return $ concat $ intersperse ",\n" (reverse colStrs)
-
-column :: String -> ColumnType -> [ColumnConstraint] -> CreateTable ()
-column colName colType constraints = do
-  modify $ \cols -> (colType, colName, constraints):cols
-
diff --git a/Web/REST.hs b/Web/REST.hs
--- a/Web/REST.hs
+++ b/Web/REST.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
 module Web.REST
-  ( RESTController
+  ( REST(..), RESTController, rest
   , index, show, create, update, delete
   , edit, new
   ) where
@@ -8,12 +8,12 @@
 import Prelude hiding (show)
 
 import Control.Monad.Trans.State
-import Data.Conduit
+import Control.Monad.Identity
 import Web.Simple.Responses
 import Web.Simple.Router
 import Network.HTTP.Types
 
-data RESTControllerState = RESTControllerState
+data REST = REST
   { restIndex   :: Route ()
   , restShow    :: Route ()
   , restCreate  :: Route ()
@@ -23,8 +23,8 @@
   , restNew     :: Route ()
   }
 
-defaultRESTControllerState :: RESTControllerState
-defaultRESTControllerState = RESTControllerState
+defaultREST :: REST
+defaultREST = REST
   { restIndex   = routeAll $ notFound
   , restShow    = routeAll $ notFound
   , restCreate  = routeAll $ notFound
@@ -34,7 +34,7 @@
   , restNew     = routeAll $ notFound
   }
 
-instance Routeable RESTControllerState where
+instance Routeable REST where
   runRoute controller = runRoute $ do
     routeMethod GET $ do
       routeTop $ restIndex controller
@@ -45,17 +45,20 @@
 
     routeMethod POST $ routeTop $ restCreate controller
 
-    routeMethod PUT $ routeVar "id" $ restUpdate controller
-
     routeMethod DELETE $ routeVar "id" $ restDelete controller
 
-type RESTControllerM a = StateT RESTControllerState (ResourceT IO) a
+    routeMethod PUT $ routeVar "id" $ restUpdate controller
 
+type RESTControllerM a = StateT REST Identity a
+
 instance Routeable (RESTControllerM a) where
   runRoute controller = rt
     where rt req = do
-            (_, st) <- runStateT controller defaultRESTControllerState
+            let (_, st) = runIdentity $ runStateT controller defaultREST
             runRoute st req
+
+rest :: RESTControllerM a -> REST
+rest controller = snd . runIdentity $ runStateT controller defaultREST
 
 type RESTController = RESTControllerM ()
 
diff --git a/Web/Simple/Controller.hs b/Web/Simple/Controller.hs
--- a/Web/Simple/Controller.hs
+++ b/Web/Simple/Controller.hs
@@ -87,13 +87,26 @@
 -- @
 --
 -- would return /Nothing/
-queryParam :: S8.ByteString -- ^ Parameter name
-           -> Controller (Maybe S8.ByteString)
+queryParam :: Parseable a => S8.ByteString -- ^ Parameter name
+           -> Controller (Maybe a)
 queryParam varName = do
   qr <- fmap queryString request
   case lookup varName qr of
-    Just n -> return n
+    Just p -> return $ fmap parse p
     _ -> return Nothing
+
+class Parseable a where
+  parse :: S8.ByteString -> a
+
+instance Parseable S8.ByteString where
+  parse = id
+instance Parseable String where
+  parse = S8.unpack
+instance Parseable Integer where
+  parse = parseReadable
+
+parseReadable :: Read a => S8.ByteString -> a
+parseReadable = read . S8.unpack
 
 -- | An alias for 'return' that's helps the the compiler type a code block as a
 -- 'Controller'. For example, when using the 'Network.Wai.Frank' routing DSL to
diff --git a/Web/Simple/Migrations.hs b/Web/Simple/Migrations.hs
new file mode 100644
--- /dev/null
+++ b/Web/Simple/Migrations.hs
@@ -0,0 +1,27 @@
+module Web.Simple.Migrations
+  ( Migration
+  , newMigration
+  ) where
+
+import System.Locale
+import System.Time
+
+type Migration =  String -- ^ Version
+               -> String -- ^ Migration name
+               -> IO Bool
+
+newMigration :: String -> IO ()
+newMigration name = do
+  time <- getClockTime >>= return . toUTCTime
+  let timestr = formatCalendarTime defaultTimeLocale
+                  "%Y%m%d%H%M%S" time
+  writeFile ("migrate/" ++ timestr ++ "_" ++ name ++ ".hs") migrationTemplate
+
+migrationTemplate :: String
+migrationTemplate = concat
+  [ "import Web.Simple.Migrations\n\n"
+  , "up :: Migration\n"
+  , "up = const . const $ return False\n\n"
+  , "down :: Migration\n"
+  , "down = const . const $ return False\n\n"]
+
diff --git a/Web/Simple/Responses.hs b/Web/Simple/Responses.hs
--- a/Web/Simple/Responses.hs
+++ b/Web/Simple/Responses.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module defines some convenience functions for creating responses.
 module Web.Simple.Responses
-  ( ok, okHtml
+  ( ok, okHtml, okJson
   , movedTo, redirectTo
   , badRequest, requireBasicAuth, forbidden
   , notFound
@@ -32,6 +32,11 @@
 okHtml :: L8.ByteString -> Response
 okHtml body =
   mkHtmlResponse status200 [] body
+
+-- | Creates a 200 (OK) 'Response' with content-type \"application/json\" and the
+-- given resposne body
+okJson :: L8.ByteString -> Response
+okJson = ok (S8.pack "application/json")
 
 -- | Given a URL returns a 301 (Moved Permanently) 'Response' redirecting to
 -- that URL.
diff --git a/simple.cabal b/simple.cabal
--- a/simple.cabal
+++ b/simple.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                simple
-version:             0.3.0
+version:             0.4.0
 synopsis: A minimalist web framework for the WAI server interface
 description:
 
@@ -45,11 +45,37 @@
 build-type:          Simple
 cabal-version:       >=1.9.2
 
+executable smpl
+  Main-Is: smpl.hs
+  build-depends:
+    attoparsec >= 0.10.3,
+    base >= 4.5 && < 5.0,
+    base64-bytestring >= 1.0 && < 1.1,
+    cmdargs >= 0.10.2,
+    conduit >= 0.5,
+    hint >= 0.3.3 && < 0.4,
+    system-filepath >= 0.4.7 && < 0.5,
+    system-fileio >= 0.3.11 && < 0.4,
+    old-locale,
+    old-time,
+    wai >= 1.3 && < 2.0,
+    wai-extra >= 1.3 && < 2.0,
+    wai-handler-devel >= 1.3,
+    http-types >= 0.7.1,
+    text >= 0.11,
+    transformers >= 0.3,
+    bytestring >= 0.9,
+    postgresql-simple >= 0.2.4.1,
+    network >= 2.4,
+    mtl >= 2.1
+
 library
   build-depends:
     base >=4.5 && < 5.0,
     base64-bytestring >= 1.0 && < 1.1,
     conduit >= 0.5,
+    old-locale,
+    old-time,
     wai >= 1.3 && < 2.0,
     wai-extra >= 1.3 && < 2.0,
     http-types >= 0.7.1,
@@ -57,6 +83,8 @@
     transformers >= 0.3,
     bytestring >= 0.9,
     postgresql-simple >= 0.2.4.1,
+    resource-pool >= 0.2.1 && < 0.3,
+    resourcet >= 0.4.4,
     network >= 2.4,
     mtl >= 2.1
 
@@ -64,12 +92,13 @@
 
   exposed-modules:
     Database.PostgreSQL.Models,
-    Database.Connection,
-    Database.Migrations,
-    Database.Sequel,
+    Database.PostgreSQL.Connection,
+    Database.PostgreSQL.Migrations,
+    Database.PostgreSQL.Sequel,
     Web.Simple,
     Web.Simple.Auth,
     Web.Simple.Controller,
+    Web.Simple.Migrations,
     Web.Simple.Responses,
     Web.Simple.Router,
     Web.Frank,
diff --git a/smpl.hs b/smpl.hs
new file mode 100644
--- /dev/null
+++ b/smpl.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Prelude hiding (writeFile)
+import Control.Monad
+import qualified Data.ByteString.Char8 as S8
+import Data.List (sort)
+import Data.String
+import Filesystem hiding (concat)
+import Filesystem.Path hiding (concat)
+import Filesystem.Path.CurrentOS hiding (concat)
+import Language.Haskell.Interpreter hiding (name)
+import Network.Wai.Handler.DevelServer (runQuit)
+import System.Console.CmdArgs
+import System.Environment
+
+import Web.Simple.Migrations
+import Web.Simple.Router ()
+
+data Smpl =
+    Server
+      { port :: Int
+      , moduleName :: String
+      } |
+    New
+      { thing :: String
+      , newArgs :: [String]} |
+    Create { appName :: String } |
+    Migrate |
+    Rollback
+      { steps :: Int }
+    deriving (Show, Data, Typeable)
+
+main :: IO ()
+main = do
+    env <- getEnvironment
+    let myport = maybe 3000 read $ lookup "PORT" env
+    let develMode = cmdArgsMode $ modes
+                  [ Server { port = myport &= typ "PORT"
+                           , moduleName = "Main" &= typ "MODULE"
+                                        &= explicit &= name "module"
+                           } &= auto
+                  , New { thing = "migration" &= argPos 0 &= typ "migration|..."
+                        , newArgs = [] &= args }
+                  , Create { appName = "" &= argPos 0 &= typ "APP_NAME" }
+                  , Migrate
+                  , Rollback { steps = 1 &= typ "INTEGER" }]
+    smpl <- cmdArgsRun develMode
+    case smpl of
+      Server p m -> do
+        runQuit p m "app" (const $ return [])
+        putStrLn $ "Starting server on port " ++ (show myport)
+      Rollback steps -> do
+        fls <- listDirectory "migrate"
+        whileI steps (reverse . sort $ fls) $ \f -> do
+          let fileName = encodeString $ filename f
+          let version = takeWhile (/= '_') fileName
+          let mname = drop 1 $ dropWhile (/= '_') $
+                        takeWhile (/= '.') fileName
+          runRollback (encodeString f) version mname
+      Migrate -> do
+        fls <- listDirectory "migrate"
+        forM_ (sort fls) $ \f -> do
+          let fileName = encodeString $ filename f
+          let version = takeWhile (/= '_') fileName
+          let mname = drop 1 $ dropWhile (/= '_') $
+                        takeWhile (/= '.') fileName
+          runMigration (encodeString f) version mname
+      New "migration" (name:[]) -> do
+        putStrLn $ "Creating migration " ++ name
+        newMigration name
+      Create appName -> createApplication appName
+      otherwise -> return ()
+  where whileI 0 _ _ = return ()
+        whileI _ [] _ = return ()
+        whileI i (f:fs) act = do
+          b <- act f
+          if b then whileI (i - 1) fs act
+            else whileI i fs act
+
+runMigration :: String -> String -> String -> IO Bool
+runMigration fileName version mname = do
+  eup <- runInterpreter $ do
+    loadModules [fileName]
+    setImports ["Prelude"]
+    setTopLevelModules ["Main"]
+    interpret "up" (undefined :: Migration)
+  case eup of
+    Right up -> do
+                  res <- up version mname
+                  when res $ putStrLn $ "=== " ++
+                      "Finished migration " ++ mname ++ " (" ++ version ++ ")"
+                  return res
+    Left err -> fail $ show err
+
+runRollback :: String -> String -> String -> IO Bool
+runRollback fileName version mname = do
+  edown <- runInterpreter $ do
+    loadModules [fileName]
+    setImports ["Prelude"]
+    setTopLevelModules ["Main"]
+    interpret "down" (undefined :: Migration)
+  case edown of
+    Right down -> do
+                  res <- down version mname
+                  when res $ putStrLn $ "=== " ++
+                      "Finished rollback " ++ mname ++ " (" ++ version ++ ")"
+                  return res
+    Left err -> fail $ show err
+
+createApplication :: String -> IO ()
+createApplication appName = do
+  createTree $ fromString appName </> "migrate"
+  writeFile (fromString appName </> "Main.hs") mainTemplate
+
+mainTemplate :: S8.ByteString
+mainTemplate = S8.concat
+  [ "{-# LANGUAGE OverloadedStrings #-}\n\n"
+  , "module Main where\n\n"
+  , "import Web.Simple\n\n"
+  , "app runner = runner $ mkRouter $ do\n"
+  , "               routeAll $ okHtml \"Hello World\"\n\n"]
+