diff --git a/CodeGenQ.hs b/CodeGenQ.hs
--- a/CodeGenQ.hs
+++ b/CodeGenQ.hs
@@ -16,10 +16,10 @@
     let s = killFirstBlank s'
     case parse (many parseToken) s s of
         Left e -> error $ show e
-        Right tokens -> do
-            let tokens' = map toExp tokens
+        Right tokens' -> do
+            let tokens'' = map toExp tokens'
             concat' <- [|concat|]
-            return $ concat' `AppE` ListE tokens'
+            return $ concat' `AppE` ListE tokens''
   where
     killFirstBlank ('\n':x) = x
     killFirstBlank ('\r':'\n':x) = x
diff --git a/Yesod.hs b/Yesod.hs
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -11,7 +11,9 @@
     , module Yesod.Json
     , module Yesod.Widget
     , Application
+    , lift
     , liftIO
+    , MonadCatchIO
     , mempty
     ) where
 
@@ -19,18 +21,21 @@
 import Yesod.Content hiding (testSuite)
 import Yesod.Json hiding (testSuite)
 import Yesod.Dispatch hiding (testSuite)
+import Yesod.Yesod hiding (testSuite)
 #else
 import Yesod.Content
 import Yesod.Json
 import Yesod.Dispatch
+import Yesod.Yesod
 #endif
 
 import Yesod.Request
 import Yesod.Form
-import Yesod.Yesod
 import Yesod.Widget
 import Yesod.Handler hiding (runHandler)
 import Network.Wai (Application)
 import Yesod.Hamlet
+import "transformers" Control.Monad.Trans.Class (lift)
 import "transformers" Control.Monad.IO.Class (liftIO)
+import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO)
 import Data.Monoid (mempty)
diff --git a/Yesod/Content.hs b/Yesod/Content.hs
--- a/Yesod/Content.hs
+++ b/Yesod/Content.hs
@@ -245,8 +245,8 @@
 
 caseTypeByExt :: Assertion
 caseTypeByExt = do
-    typeJavascript @=? typeByExt (ext "foo.js")
-    typeHtml @=? typeByExt (ext "foo.html")
+    Just typeJavascript @=? lookup (ext "foo.js") typeByExt
+    Just typeHtml @=? lookup (ext "foo.html") typeByExt
 #endif
 
 -- | Format a 'UTCTime' in W3 format; useful for setting cookies.
diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -18,26 +18,29 @@
     , toWaiApp
     , basicHandler
     , basicHandler'
-      -- * Utilities
-    , fullRender
 #if TEST
     , testSuite
 #endif
     ) where
 
-import Yesod.Handler
+#if TEST
+import Yesod.Yesod hiding (testSuite)
+#else
 import Yesod.Yesod
+#endif
+
+import Yesod.Handler
 import Yesod.Request
 import Yesod.Internal
 
 import Web.Routes.Quasi
 import Web.Routes.Quasi.Parse
 import Web.Routes.Quasi.TH
-import Web.Routes.Site
 import Language.Haskell.TH.Syntax
+import Yesod.WebRoutes
 
 import qualified Network.Wai as W
-import Network.Wai.Middleware.CleanPath
+import Network.Wai.Middleware.CleanPath (cleanPathFunc)
 import Network.Wai.Middleware.Jsonp
 import Network.Wai.Middleware.Gzip
 
@@ -46,7 +49,6 @@
 import System.Environment (getEnvironment)
 
 import qualified Data.ByteString.Char8 as B
-import Web.Routes (encodePathInfo)
 
 import qualified Data.ByteString.UTF8 as S
 
@@ -93,7 +95,7 @@
 -- executable by itself, but instead provides functionality to
 -- be embedded in other sites.
 mkYesodSub :: String -- ^ name of the argument datatype
-           -> [(String, [Name])]
+           -> Cxt
            -> [Resource]
            -> Q [Dec]
 mkYesodSub name clazzes =
@@ -119,18 +121,9 @@
 mkYesodDispatch :: String -> [Resource] -> Q [Dec]
 mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False
 
-typeHelper :: String -> Type
-typeHelper =
-    foldl1 AppT . map go . words
-  where
-    go s@(x:_)
-        | isLower x = VarT $ mkName s
-        | otherwise = ConT $ mkName s
-    go [] = error "typeHelper: empty string to go"
-
 mkYesodGeneral :: String -- ^ argument name
                -> [String] -- ^ parameters for site argument
-               -> [(String, [Name])] -- ^ classes
+               -> Cxt -- ^ classes
                -> Bool -- ^ is subsite?
                -> [Resource]
                -> Q ([Dec], [Dec])
@@ -138,10 +131,6 @@
     let name' = mkName name
         args' = map mkName args
         arg = foldl AppT (ConT name') $ map VarT args'
-    let clazzes' = map (\(x, y) -> ClassP x [typeHelper y])
-                 $ concatMap (\(x, y) -> zip y $ repeat x)
-                 $ compact
-                 $ map (\x -> (x, [])) ("master" : args) ++ clazzes
     th <- mapM (thResourceFromResource arg) res -- FIXME now we cannot have multi-nested subsites
     w' <- createRoutes th
     let routesName = mkName $ name ++ "Route"
@@ -166,7 +155,7 @@
     let site' = site `AppE` dispatch `AppE` render `AppE` parse
     let (ctx, ytyp, yfunc) =
             if isSub
-                then (clazzes', ConT ''YesodSubSite `AppT` arg `AppT` VarT (mkName "master"), "getSubSite")
+                then (clazzes, ConT ''YesodSubSite `AppT` arg `AppT` VarT (mkName "master"), "getSubSite")
                 else ([], ConT ''YesodSite `AppT` arg, "getSite")
     let y = InstanceD ctx ytyp
                 [ FunD (mkName yfunc) [Clause [] (NormalB site') []]
@@ -212,13 +201,6 @@
 thResourceFromResource _ (Resource n _ _) =
     error $ "Invalid attributes for resource: " ++ n
 
-compact :: [(String, [a])] -> [(String, [a])]
-compact [] = []
-compact ((x, x'):rest) =
-    let ys = filter (\(y, _) -> y == x) rest
-        zs = filter (\(z, _) -> z /= x) rest
-     in (x, x' ++ concatMap snd ys) : compact zs
-
 sessionName :: String
 sessionName = "_SESSION"
 
@@ -228,7 +210,7 @@
 toWaiApp a =
     return $ gzip
            $ jsonp
-           $ cleanPathRel (B.pack $ approot a)
+           $ cleanPathFunc (splitPath a) (B.pack $ approot a)
            $ toWaiApp' a
 
 toWaiApp' :: (Yesod y, YesodSite y)
@@ -251,16 +233,20 @@
         types = httpAccept env
         pathSegments = filter (not . null) segments
         eurl = parsePathSegments site pathSegments
-        render u = fromMaybe
-                    (fullRender (approot y) (formatPathSegments site) u)
+        render u qs =
+            let (ps, qs') = formatPathSegments site u
+             in fromMaybe
+                    (joinPath y (approot y) ps $ qs ++ qs')
                     (urlRenderOverride y u)
+    let errorHandler' = localNoCurrent . errorHandler
     rr <- parseWaiRequest env session'
     let h = do
           onRequest
           case eurl of
-            Left _ -> errorHandler NotFound
+            Left _ -> errorHandler' NotFound
             Right url -> do
-                ar <- isAuthorized url
+                isWrite <- isWriteRequest url
+                ar <- isAuthorized url isWrite
                 case ar of
                     Authorized -> return ()
                     AuthenticationRequired ->
@@ -272,10 +258,10 @@
                                 redirect RedirectTemporary url'
                     Unauthorized s -> permissionDenied s
                 case handleSite site render url method of
-                    Nothing -> errorHandler $ BadMethod method
+                    Nothing -> errorHandler' $ BadMethod method
                     Just h' -> h'
     let eurl' = either (const Nothing) Just eurl
-    let eh er = runHandler (errorHandler er) render eurl' id y id
+    let eh er = runHandler (errorHandler' er) render eurl' id y id
     let ya = runHandler h render eurl' id y id
     (s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types
     let sessionVal = encodeSession key' exp' host sessionFinal
@@ -286,19 +272,6 @@
         hs''' = ("Content-Type", S.fromString ct) : hs''
     return $ W.Response s hs''' c
 
--- | Fully render a route to an absolute URL. Since Yesod does this for you
--- internally, you will rarely need access to this. However, if you need to
--- generate links /outside/ of the Handler monad, this may be useful.
---
--- For example, if you want to generate an e-mail which links to your site,
--- this is the function you would want to use.
-fullRender :: String -- ^ approot, no trailing slash
-           -> (url -> [String])
-           -> url
-           -> String
-fullRender ar render route =
-    ar ++ '/' : encodePathInfo (fixSegs $ render route)
-
 httpAccept :: W.Request -> [ContentType]
 httpAccept = map B.unpack
            . parseHttpAccept
@@ -333,13 +306,6 @@
                     ["http://", h, ":", show port, "/"]
             SS.run port app
         Just _ -> CGI.run app
-
-fixSegs :: [String] -> [String]
-fixSegs [] = []
-fixSegs [x]
-    | any (== '.') x = [x]
-    | otherwise = [x, ""] -- append trailing slash
-fixSegs (x:xs) = x : fixSegs xs
 
 parseWaiRequest :: W.Request
                 -> [(String, String)] -- ^ session
diff --git a/Yesod/Form.hs b/Yesod/Form.hs
--- a/Yesod/Form.hs
+++ b/Yesod/Form.hs
@@ -1,193 +1,67 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -- | Parse forms (and query strings).
 module Yesod.Form
     ( -- * Data types
-      GForm (..)
+      GForm
+    , FormResult (..)
+    , Enctype (..)
+    , FormFieldSettings (..)
+    , Textarea (..)
+      -- * Type synonyms
     , Form
     , Formlet
     , FormField
     , FormletField
     , FormInput
-    , FormResult (..)
-    , Enctype (..)
-    , FieldInfo (..)
-      -- * Newtype wrappers
-    , JqueryDay (..)
-    , NicHtml (..)
-    , Html'
       -- * Unwrapping functions
     , runFormGet
     , runFormPost
     , runFormGet'
     , runFormPost'
-      -- * Type classes
-    , ToForm (..)
-    , ToFormField (..)
       -- * Field/form helpers
-    , requiredFieldHelper
-    , optionalFieldHelper
-    , mapFormXml
-    , newFormIdent
     , fieldsToTable
     , fieldsToPlain
-    , fieldsToInput
-      -- * Field profiles
-    , FieldProfile (..)
-    , stringFieldProfile
-    , intFieldProfile
-    , dayFieldProfile
-    , jqueryDayFieldProfile
-    , timeFieldProfile
-    , htmlFieldProfile
-    , emailFieldProfile
-      -- * Pre-built fields
-    , stringField
-    , maybeStringField
-    , intField
-    , maybeIntField
-    , doubleField
-    , maybeDoubleField
-    , dayField
-    , maybeDayField
-    , jqueryDayField
-    , maybeJqueryDayField
-    , timeField
-    , maybeTimeField
-    , htmlField
-    , maybeHtmlField
-    , nicHtmlField
-    , maybeNicHtmlField
-    , selectField
-    , maybeSelectField
-    , boolField
-    , jqueryAutocompleteField
-    , maybeJqueryAutocompleteField
-    , emailField
-    , maybeEmailField
-      -- * Pre-built inputs
-    , stringInput
-    , maybeStringInput
-    , boolInput
-    , dayInput
-    , maybeDayInput
-    , emailInput
+    , checkForm
       -- * Template Haskell
-    , share2
     , mkToForm
+      -- * Re-exports
+    , module Yesod.Form.Fields
+    , module Yesod.Form.Class
     ) where
 
+import Yesod.Form.Core
+import Yesod.Form.Fields
+import Yesod.Form.Class
+import Yesod.Form.Profiles (Textarea (..))
+
 import Text.Hamlet
 import Yesod.Request
 import Yesod.Handler
 import Control.Applicative hiding (optional)
-import Data.Time (Day, TimeOfDay (TimeOfDay))
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, mapMaybe)
 import "transformers" Control.Monad.IO.Class
-import Control.Monad ((<=<), liftM, join)
-import Data.Monoid (Monoid (..))
+import Control.Monad ((<=<))
 import Control.Monad.Trans.State
+import Control.Monad.Trans.Reader
 import Language.Haskell.TH.Syntax
-import Database.Persist.Base (EntityDef (..), PersistField)
+import Database.Persist.Base (EntityDef (..))
 import Data.Char (toUpper, isUpper)
-import Data.Int (Int64)
-import qualified Data.ByteString.Lazy.UTF8 as U
 import Yesod.Widget
 import Control.Arrow ((&&&))
-import qualified Text.Email.Validate as Email
-
--- | A form can produce three different results: there was no data available,
--- the data was invalid, or there was a successful parse.
---
--- The 'Applicative' instance will concatenate the failure messages in two
--- 'FormResult's.
-data FormResult a = FormMissing
-                  | FormFailure [String]
-                  | FormSuccess a
-    deriving Show
-instance Functor FormResult where
-    fmap _ FormMissing = FormMissing
-    fmap _ (FormFailure errs) = FormFailure errs
-    fmap f (FormSuccess a) = FormSuccess $ f a
-instance Applicative FormResult where
-    pure = FormSuccess
-    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
-    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
-    (FormFailure x) <*> _ = FormFailure x
-    _ <*> (FormFailure y) = FormFailure y
-    _ <*> _ = FormMissing
-
--- | The encoding type required by a form. The 'Show' instance produces values
--- that can be inserted directly into HTML.
-data Enctype = UrlEncoded | Multipart
-instance Show Enctype where
-    show UrlEncoded = "application/x-www-form-urlencoded"
-    show Multipart = "multipart/form-data"
-instance Monoid Enctype where
-    mempty = UrlEncoded
-    mappend UrlEncoded UrlEncoded = UrlEncoded
-    mappend _ _ = Multipart
-
--- | A generic form, allowing you to specifying the subsite datatype, master
--- site datatype, a datatype for the form XML and the return type.
-newtype GForm sub y xml a = GForm
-    { deform :: Env -> FileEnv -> StateT Int (GHandler sub y) (FormResult a, xml, Enctype)
-    }
-type Form sub y = GForm sub y (GWidget sub y ())
-type Formlet sub y a = Maybe a -> Form sub y a
-type FormField sub y = GForm sub y [FieldInfo sub y]
-type FormletField sub y a = Maybe a -> FormField sub y a
-type FormInput sub y = GForm sub y [GWidget sub y ()]
-
--- | Convert the XML in a 'GForm'.
-mapFormXml :: (xml1 -> xml2) -> GForm s y xml1 a -> GForm s y xml2 a
-mapFormXml f (GForm g) = GForm $ \e fe -> do
-    (res, xml, enc) <- g e fe
-    return (res, f xml, enc)
-
--- | Using this as the intermediate XML representation for fields allows us to
--- write generic field functions and then different functions for producing
--- actual HTML. See, for example, 'fieldsToTable' and 'fieldsToPlain'.
-data FieldInfo sub y = FieldInfo
-    { fiLabel :: Html ()
-    , fiTooltip :: Html ()
-    , fiIdent :: String
-    , fiInput :: GWidget sub y ()
-    , fiErrors :: Maybe (Html ())
-    }
-
-type Env = [(String, String)]
-type FileEnv = [(String, FileInfo)]
-
-instance Monoid xml => Functor (GForm sub url xml) where
-    fmap f (GForm g) =
-        GForm $ \env fe -> liftM (first3 $ fmap f) (g env fe)
-      where
-        first3 f' (x, y, z) = (f' x, y, z)
-
-instance Monoid xml => Applicative (GForm sub url xml) where
-    pure a = GForm $ const $ const $ return (pure a, mempty, mempty)
-    (GForm f) <*> (GForm g) = GForm $ \env fe -> do
-        (f1, f2, f3) <- f env fe
-        (g1, g2, g3) <- g env fe
-        return (f1 <*> g1, f2 `mappend` g2, f3 `mappend` g3)
+import Data.List (group, sort)
 
 -- | Display only the actual input widget code, without any decoration.
-fieldsToPlain :: [FieldInfo sub y] -> GWidget sub y ()
-fieldsToPlain = mapM_ fiInput
-
-fieldsToInput :: [FieldInfo sub y] -> [GWidget sub y ()]
-fieldsToInput = map fiInput
+fieldsToPlain :: FormField sub y a -> Form sub y a
+fieldsToPlain = mapFormXml $ mapM_ fiInput
 
 -- | Display the label, tooltip, input code and errors in a single row of a
 -- table.
-fieldsToTable :: [FieldInfo sub y] -> GWidget sub y ()
-fieldsToTable = mapM_ go
+fieldsToTable :: FormField sub y a -> Form sub y a
+fieldsToTable = mapFormXml $ mapM_ go
   where
     go fi = do
         wrapWidget (fiInput fi) $ \w -> [$hamlet|
@@ -201,529 +75,12 @@
         %td.errors $err$
 |]
 
-class ToForm a where
-    toForm :: Maybe a -> Form sub y a
-class ToFormField a where
-    toFormField :: Html () -> Html () -> Maybe a -> FormField sub y a
-
--- | Create a required field (ie, one that cannot be blank) from a
--- 'FieldProfile'.
-requiredFieldHelper :: FieldProfile sub y a -> Maybe a -> FormField sub y a
-requiredFieldHelper (FieldProfile parse render mkXml w name' label tooltip) orig =
-  GForm $ \env _ -> do
-    name <- maybe newFormIdent return name'
-    let (res, val) =
-            if null env
-                then (FormMissing, maybe "" render orig)
-                else case lookup name env of
-                        Nothing -> (FormMissing, "")
-                        Just "" -> (FormFailure ["Value is required"], "")
-                        Just x ->
-                            case parse x of
-                                Left e -> (FormFailure [e], x)
-                                Right y -> (FormSuccess y, x)
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = name
-            , fiInput = w name >> addBody (mkXml (string name) (string val) True)
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-
--- | Create an optional field (ie, one that can be blank) from a
--- 'FieldProfile'.
-optionalFieldHelper :: FieldProfile sub y a -> Maybe (Maybe a)
-                    -> FormField sub y (Maybe a)
-optionalFieldHelper (FieldProfile parse render mkXml w name' label tooltip) orig' =
-  GForm $ \env _ -> do
-    let orig = join orig'
-    name <- maybe newFormIdent return name'
-    let (res, val) =
-            if null env
-                then (FormSuccess Nothing, maybe "" render orig)
-                else case lookup name env of
-                        Nothing -> (FormSuccess Nothing, "")
-                        Just "" -> (FormSuccess Nothing, "")
-                        Just x ->
-                            case parse x of
-                                Left e -> (FormFailure [e], x)
-                                Right y -> (FormSuccess $ Just y, x)
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = name
-            , fiInput = w name >> addBody (mkXml (string name) (string val) False)
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-
--- | A generic definition of a form field that can be used for generating both
--- required and optional fields. See 'requiredFieldHelper and
--- 'optionalFieldHelper'.
-data FieldProfile sub y a = FieldProfile
-    { fpParse :: String -> Either String a
-    , fpRender :: a -> String
-    , fpHamlet :: Html () -> Html () -> Bool -> Hamlet (Route y)
-    , fpWidget :: String -> GWidget sub y ()
-    , fpName :: Maybe String
-    , fpLabel :: Html ()
-    , fpTooltip :: Html ()
-    }
-
---------------------- Begin prebuilt forms
-
-stringField :: Html () -> Html () -> FormletField sub y String
-stringField label tooltip = requiredFieldHelper stringFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-maybeStringField :: Html () -> Html () -> FormletField sub y (Maybe String)
-maybeStringField label tooltip = optionalFieldHelper stringFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-stringFieldProfile :: FieldProfile sub y String
-stringFieldProfile = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!type=text!:isReq:required!value=$val$
-|]
-    , fpWidget = \_name -> return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-instance ToFormField String where
-    toFormField = stringField
-instance ToFormField (Maybe String) where
-    toFormField = maybeStringField
-
-intField :: Integral i => Html () -> Html () -> FormletField sub y i
-intField l t = requiredFieldHelper intFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-maybeIntField :: Integral i =>
-              Html () -> Html () -> FormletField sub y (Maybe i)
-maybeIntField l t = optionalFieldHelper intFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-intFieldProfile :: Integral i => FieldProfile sub y i
-intFieldProfile = FieldProfile
-    { fpParse = maybe (Left "Invalid integer") Right . readMayI
-    , fpRender = showI
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!type=number!:isReq:required!value=$val$
-|]
-    , fpWidget = \_name -> return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-  where
-    showI x = show (fromIntegral x :: Integer)
-    readMayI s = case reads s of
-                    (x, _):_ -> Just $ fromInteger x
-                    [] -> Nothing
-instance ToFormField Int where
-    toFormField = intField
-instance ToFormField (Maybe Int) where
-    toFormField = maybeIntField
-instance ToFormField Int64 where
-    toFormField = intField
-instance ToFormField (Maybe Int64) where
-    toFormField = maybeIntField
-
-doubleField :: Html () -> Html () -> FormletField sub y Double
-doubleField l t = requiredFieldHelper doubleFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-maybeDoubleField :: Html () -> Html () -> FormletField sub y (Maybe Double)
-maybeDoubleField l t = optionalFieldHelper doubleFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-doubleFieldProfile :: FieldProfile sub y Double
-doubleFieldProfile = FieldProfile
-    { fpParse = maybe (Left "Invalid number") Right . readMay
-    , fpRender = show
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!type=number!:isReq:required!value=$val$
-|]
-    , fpWidget = \_name -> return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-instance ToFormField Double where
-    toFormField = doubleField
-instance ToFormField (Maybe Double) where
-    toFormField = maybeDoubleField
-
-dayField :: Html () -> Html () -> FormletField sub y Day
-dayField l t = requiredFieldHelper dayFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-maybeDayField :: Html () -> Html () -> FormletField sub y (Maybe Day)
-maybeDayField l t = optionalFieldHelper dayFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-dayFieldProfile :: FieldProfile sub y Day
-dayFieldProfile = FieldProfile
-    { fpParse = maybe (Left "Invalid day, must be in YYYY-MM-DD format") Right
-              . readMay
-    , fpRender = show
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!type=date!:isReq:required!value=$val$
-|]
-    , fpWidget = const $ return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-instance ToFormField Day where
-    toFormField = dayField
-instance ToFormField (Maybe Day) where
-    toFormField = maybeDayField
-
-jqueryDayField :: Html () -> Html () -> FormletField sub y Day
-jqueryDayField l t = requiredFieldHelper jqueryDayFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-maybeJqueryDayField :: Html () -> Html () -> FormletField sub y (Maybe Day)
-maybeJqueryDayField l t = optionalFieldHelper jqueryDayFieldProfile
-    { fpLabel = l
-    , fpTooltip = t
-    }
-
-jqueryDayFieldProfile :: FieldProfile sub y Day
-jqueryDayFieldProfile = FieldProfile
-    { fpParse = maybe
-                  (Left "Invalid day, must be in YYYY-MM-DD format")
-                  Right
-              . readMay
-    , fpRender = show
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!type=date!:isReq:required!value=$val$
-|]
-    , fpWidget = \name -> do
-        addScriptRemote urlJqueryJs
-        addScriptRemote urlJqueryUiJs
-        addStylesheetRemote urlJqueryUiCss
-        addJavaScript [$hamlet|
-$$(function(){$$("#$name$").datepicker({dateFormat:'yy-mm-dd'})});
-|]
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-
--- | A newtype wrapper around 'Day', using jQuery UI date picker for the
--- 'ToFormField' instance.
-newtype JqueryDay = JqueryDay { unJqueryDay :: Day }
-    deriving PersistField
-instance ToFormField JqueryDay where
-    toFormField = applyFormTypeWrappers JqueryDay unJqueryDay jqueryDayField
-instance ToFormField (Maybe JqueryDay) where
-    toFormField = applyFormTypeWrappers (fmap JqueryDay) (fmap unJqueryDay)
-                  maybeJqueryDayField
-
-parseTime :: String -> Either String TimeOfDay
-parseTime (h2:':':m1:m2:[]) = parseTimeHelper ('0', h2, m1, m2, '0', '0')
-parseTime (h1:h2:':':m1:m2:[]) = parseTimeHelper (h1, h2, m1, m2, '0', '0')
-parseTime (h1:h2:':':m1:m2:':':s1:s2:[]) =
-    parseTimeHelper (h1, h2, m1, m2, s1, s2)
-parseTime _ = Left "Invalid time, must be in HH:MM[:SS] format"
-
-parseTimeHelper :: (Char, Char, Char, Char, Char, Char)
-                -> Either [Char] TimeOfDay
-parseTimeHelper (h1, h2, m1, m2, s1, s2)
-    | h < 0 || h > 23 = Left $ "Invalid hour: " ++ show h
-    | m < 0 || m > 59 = Left $ "Invalid minute: " ++ show m
-    | s < 0 || s > 59 = Left $ "Invalid second: " ++ show s
-    | otherwise = Right $ TimeOfDay h m s
-  where
-    h = read [h1, h2]
-    m = read [m1, m2]
-    s = fromInteger $ read [s1, s2]
-
-timeField :: Html () -> Html () -> FormletField sub y TimeOfDay
-timeField label tooltip = requiredFieldHelper timeFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-maybeTimeField :: Html () -> Html () -> FormletField sub y (Maybe TimeOfDay)
-maybeTimeField label tooltip = optionalFieldHelper timeFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-timeFieldProfile :: FieldProfile sub y TimeOfDay
-timeFieldProfile = FieldProfile
-    { fpParse = parseTime
-    , fpRender = show
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!:isReq:required!value=$val$
-|]
-    , fpWidget = const $ return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-instance ToFormField TimeOfDay where
-    toFormField = timeField
-instance ToFormField (Maybe TimeOfDay) where
-    toFormField = maybeTimeField
-
-boolField :: Html () -> Html () -> Maybe Bool -> FormField sub y Bool
-boolField label tooltip orig = GForm $ \env _ -> do
-    name <- newFormIdent
-    let (res, val) =
-            if null env
-                then (FormMissing, fromMaybe False orig)
-                else case lookup name env of
-                        Nothing -> (FormSuccess False, False)
-                        Just _ -> (FormSuccess True, True)
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = name
-            , fiInput = addBody [$hamlet|
-%input#$name$!type=checkbox!name=$name$!:val:checked
-|]
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-instance ToFormField Bool where
-    toFormField = boolField
-
-htmlField :: Html () -> Html () -> FormletField sub y (Html ())
-htmlField label tooltip = requiredFieldHelper htmlFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-maybeHtmlField :: Html () -> Html () -> FormletField sub y (Maybe (Html ()))
-maybeHtmlField label tooltip = optionalFieldHelper htmlFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-htmlFieldProfile :: FieldProfile sub y (Html ())
-htmlFieldProfile = FieldProfile
-    { fpParse = Right . preEscapedString
-    , fpRender = U.toString . renderHtml
-    , fpHamlet = \name val _isReq -> [$hamlet|
-%textarea.html#$name$!name=$name$ $val$
-|]
-    , fpWidget = const $ return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-instance ToFormField (Html ()) where
-    toFormField = htmlField
-instance ToFormField (Maybe (Html ())) where
-    toFormField = maybeHtmlField
-
-newtype NicHtml = NicHtml { unNicHtml :: Html () }
-    deriving PersistField
-
-type Html' = Html ()
-
-nicHtmlField :: Html () -> Html () -> FormletField sub y (Html ())
-nicHtmlField label tooltip = requiredFieldHelper nicHtmlFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-maybeNicHtmlField :: Html () -> Html () -> FormletField sub y (Maybe (Html ()))
-maybeNicHtmlField label tooltip = optionalFieldHelper nicHtmlFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-nicHtmlFieldProfile :: FieldProfile sub y (Html ())
-nicHtmlFieldProfile = FieldProfile
-    { fpParse = Right . preEscapedString
-    , fpRender = U.toString . renderHtml
-    , fpHamlet = \name val _isReq -> [$hamlet|
-%textarea.html#$name$!name=$name$ $val$
-|]
-    , fpWidget = \name -> do
-        addScriptRemote "http://js.nicedit.com/nicEdit-latest.js"
-        addJavaScript [$hamlet|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|]
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-instance ToFormField NicHtml where
-    toFormField = applyFormTypeWrappers NicHtml unNicHtml nicHtmlField
-instance ToFormField (Maybe NicHtml) where
-    toFormField = applyFormTypeWrappers (fmap NicHtml) (fmap unNicHtml)
-                  maybeNicHtmlField
-
-applyFormTypeWrappers :: (a -> b) -> (b -> a)
-                      -> (f -> g -> FormletField s y a)
-                      -> (f -> g -> FormletField s y b)
-applyFormTypeWrappers wrap unwrap field l t orig =
-    fmap wrap $ field l t $ fmap unwrap orig
-
-readMay :: Read a => String -> Maybe a
-readMay s = case reads s of
-                (x, _):_ -> Just x
-                [] -> Nothing
-
-selectField :: Eq x => [(x, String)]
-            -> Html () -> Html ()
-            -> Maybe x -> FormField sub master x
-selectField pairs label tooltip initial = GForm $ \env _ -> do
-    i <- newFormIdent
-    let pairs' = zip [1 :: Int ..] pairs
-    let res = case lookup i env of
-                Nothing -> FormMissing
-                Just "none" -> FormFailure ["Field is required"]
-                Just x ->
-                    case reads x of
-                        (x', _):_ ->
-                            case lookup x' pairs' of
-                                Nothing -> FormFailure ["Invalid entry"]
-                                Just (y, _) -> FormSuccess y
-                        [] -> FormFailure ["Invalid entry"]
-    let isSelected x =
-            case res of
-                FormSuccess y -> x == y
-                _ -> Just x == initial
-    let input = [$hamlet|
-%select#$i$!name=$i$
-    %option!value=none
-    $forall pairs' pair
-        %option!value=$show.fst.pair$!:isSelected.fst.snd.pair:selected $snd.snd.pair$
-|]
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = i
-            , fiInput = addBody input
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-
-maybeSelectField :: Eq x => [(x, String)]
-                 -> Html () -> Html ()
-                 -> Maybe x -> FormField sub master (Maybe x)
-maybeSelectField pairs label tooltip initial = GForm $ \env _ -> do
-    i <- newFormIdent
-    let pairs' = zip [1 :: Int ..] pairs
-    let res = case lookup i env of
-                Nothing -> FormMissing
-                Just "none" -> FormSuccess Nothing
-                Just x ->
-                    case reads x of
-                        (x', _):_ ->
-                            case lookup x' pairs' of
-                                Nothing -> FormFailure ["Invalid entry"]
-                                Just (y, _) -> FormSuccess $ Just y
-                        [] -> FormFailure ["Invalid entry"]
-    let isSelected x =
-            case res of
-                FormSuccess y -> Just x == y
-                _ -> Just x == initial
-    let input = [$hamlet|
-%select#$i$!name=$i$
-    %option!value=none
-    $forall pairs' pair
-        %option!value=$show.fst.pair$!:isSelected.fst.snd.pair:selected $snd.snd.pair$
-|]
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = i
-            , fiInput = addBody input
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-
---------------------- End prebuilt forms
-
---------------------- Begin prebuilt inputs
-
-stringInput :: String -> FormInput sub master String
-stringInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper stringFieldProfile
-    { fpName = Just n
-    } Nothing
-
-maybeStringInput :: String -> FormInput sub master (Maybe String)
-maybeStringInput n =
-    mapFormXml fieldsToInput $
-    optionalFieldHelper stringFieldProfile
-    { fpName = Just n
-    } Nothing
-
-boolInput :: String -> FormInput sub master Bool
-boolInput n = GForm $ \env _ -> return
-    (FormSuccess $ isJust $ lookup n env, return $ addBody [$hamlet|
-%input#$n$!type=checkbox!name=$n$
-|], UrlEncoded)
-
-dayInput :: String -> FormInput sub master Day
-dayInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper dayFieldProfile
-    { fpName = Just n
-    } Nothing
-
-maybeDayInput :: String -> FormInput sub master (Maybe Day)
-maybeDayInput n =
-    mapFormXml fieldsToInput $
-    optionalFieldHelper dayFieldProfile
-    { fpName = Just n
-    } Nothing
-
---------------------- End prebuilt inputs
-
--- | Get a unique identifier.
-newFormIdent :: Monad m => StateT Int m String
-newFormIdent = do
-    i <- get
-    let i' = i + 1
-    put i'
-    return $ "f" ++ show i'
-
 runFormGeneric :: Env
                -> FileEnv
                -> GForm sub y xml a
                -> GHandler sub y (FormResult a, xml, Enctype)
-runFormGeneric env fe f = evalStateT (deform f env fe) 1
+runFormGeneric env fe (GForm f) =
+    runReaderT (runReaderT (evalStateT f $ IntSingle 1) env) fe
 
 -- | Run a form against POST parameters.
 runFormPost :: GForm sub y xml a
@@ -755,19 +112,23 @@
     gs <- reqGetParams `fmap` getRequest
     runFormGeneric gs [] f
 
--- | This function allows two different monadic functions to share the same
--- input and have their results concatenated. This is particularly useful for
--- allowing 'mkToForm' to share its input with mkPersist.
-share2 :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]
-share2 f g a = do
-    f' <- f a
-    g' <- g a
-    return $ f' ++ g'
-
 -- | Create 'ToForm' instances for the entities given. In addition to regular 'EntityDef' attributes understood by persistent, it also understands label= and tooltip=.
 mkToForm :: [EntityDef] -> Q [Dec]
 mkToForm = mapM derive
   where
+    afterPeriod s =
+        case dropWhile (/= '.') s of
+            ('.':t) -> t
+            _ -> s
+    beforePeriod s =
+        case break (== '.') s of
+            (t, '.':_) -> Just t
+            _ -> Nothing
+    getSuperclass (_, _, z) = getTFF' z >>= beforePeriod
+    getTFF (_, _, z) = maybe "toFormField" afterPeriod $ getTFF' z
+    getTFF' [] = Nothing
+    getTFF' (('t':'o':'F':'o':'r':'m':'F':'i':'e':'l':'d':'=':x):_) = Just x
+    getTFF' (_:x) = getTFF' x
     getLabel (x, _, z) = fromMaybe (toLabel x) $ getLabel' z
     getLabel' [] = Nothing
     getLabel' (('l':'a':'b':'e':'l':'=':x):_) = Just x
@@ -776,9 +137,17 @@
     getTooltip' (('t':'o':'o':'l':'t':'i':'p':'=':x):_) = Just x
     getTooltip' (_:x) = getTooltip' x
     getTooltip' [] = Nothing
+    getId (_, _, z) = fromMaybe "" $ getId' z
+    getId' (('i':'d':'=':x):_) = Just x
+    getId' (_:x) = getId' x
+    getId' [] = Nothing
+    getName (_, _, z) = fromMaybe "" $ getName' z
+    getName' (('n':'a':'m':'e':'=':x):_) = Just x
+    getName' (_:x) = getName' x
+    getName' [] = Nothing
     derive :: EntityDef -> Q Dec
     derive t = do
-        let cols = map (getLabel &&& getTooltip) $ entityColumns t
+        let cols = map ((getId &&& getName) &&& ((getLabel &&& getTooltip) &&& getTFF)) $ entityColumns t
         ap <- [|(<*>)|]
         just <- [|pure|]
         nothing <- [|Nothing|]
@@ -786,7 +155,10 @@
         string' <- [|string|]
         mfx <- [|mapFormXml|]
         ftt <- [|fieldsToTable|]
-        let go_ = go ap just' string' mfx ftt
+        ffs' <- [|FormFieldSettings|]
+        let stm "" = nothing
+            stm x = just `AppE` LitE (StringL x)
+        let go_ = go ap just' ffs' stm string' mfx ftt
         let c1 = Clause [ ConP (mkName "Nothing") []
                         ]
                         (NormalB $ go_ $ zip cols $ map (const nothing) cols)
@@ -797,17 +169,27 @@
                             $ map VarP xs]]
                         (NormalB $ go_ $ zip cols xs')
                         []
-        return $ InstanceD [] (ConT ''ToForm
-                              `AppT` ConT (mkName $ entityName t))
+        let y = mkName "y"
+        let ctx = map (\x -> ClassP (mkName x) [VarT y])
+                $ map head $ group $ sort
+                $ mapMaybe getSuperclass
+                $ entityColumns t
+        return $ InstanceD ctx ( ConT ''ToForm
+                              `AppT` ConT (mkName $ entityName t)
+                              `AppT` VarT y)
             [FunD (mkName "toForm") [c1, c2]]
-    go ap just' string' mfx ftt a =
-        let x = foldl (ap' ap) just' $ map (go' string') a
+    go ap just' ffs' stm string' mfx ftt a =
+        let x = foldl (ap' ap) just' $ map (go' ffs' stm string') a
          in mfx `AppE` ftt `AppE` x
-    go' string' ((label, tooltip), ex) =
+    go' ffs' stm string' (((theId, name), ((label, tooltip), tff)), ex) =
         let label' = string' `AppE` LitE (StringL label)
             tooltip' = string' `AppE` LitE (StringL tooltip)
-         in VarE (mkName "toFormField") `AppE` label'
-                `AppE` tooltip' `AppE` ex
+            ffs = ffs' `AppE`
+                  label' `AppE`
+                  tooltip' `AppE`
+                  (stm theId) `AppE`
+                  (stm name)
+         in VarE (mkName tff) `AppE` ffs `AppE` ex
     ap' ap x y = InfixE (Just x) ap (Just y)
 
 toLabel :: String -> String
@@ -818,72 +200,3 @@
     go (c:cs)
         | isUpper c = ' ' : c : go cs
         | otherwise = c : go cs
-
-jqueryAutocompleteField ::
-    Route y -> Html () -> Html () -> FormletField sub y String
-jqueryAutocompleteField src l t =
-    requiredFieldHelper $ (jqueryAutocompleteFieldProfile src)
-        { fpLabel = l
-        , fpTooltip = t
-        }
-
-maybeJqueryAutocompleteField ::
-    Route y -> Html () -> Html () -> FormletField sub y (Maybe String)
-maybeJqueryAutocompleteField src l t =
-    optionalFieldHelper $ (jqueryAutocompleteFieldProfile src)
-        { fpLabel = l
-        , fpTooltip = t
-        }
-
-jqueryAutocompleteFieldProfile :: Route y -> FieldProfile sub y String
-jqueryAutocompleteFieldProfile src = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input.autocomplete#$name$!name=$name$!type=text!:isReq:required!value=$val$
-|]
-    , fpWidget = \name -> do
-        addScriptRemote urlJqueryJs
-        addScriptRemote urlJqueryUiJs
-        addStylesheetRemote urlJqueryUiCss
-        addJavaScript [$hamlet|
-$$(function(){$$("#$name$").autocomplete({source:"@src@",minLength:2})});
-|]
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-
-emailFieldProfile :: FieldProfile s y String
-emailFieldProfile = FieldProfile
-    { fpParse = \s -> if Email.isValid s
-                        then Right s
-                        else Left "Invalid e-mail address"
-    , fpRender = id
-    , fpHamlet = \name val isReq -> [$hamlet|
-%input#$name$!name=$name$!type=email!:isReq:required!value=$val$
-|]
-    , fpWidget = const $ return ()
-    , fpName = Nothing
-    , fpLabel = mempty
-    , fpTooltip = mempty
-    }
-
-emailField :: Html () -> Html () -> FormletField sub y String
-emailField label tooltip = requiredFieldHelper emailFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-maybeEmailField :: Html () -> Html () -> FormletField sub y (Maybe String)
-maybeEmailField label tooltip = optionalFieldHelper emailFieldProfile
-    { fpLabel = label
-    , fpTooltip = tooltip
-    }
-
-emailInput :: String -> FormInput sub master String
-emailInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper emailFieldProfile
-    { fpName = Just n
-    } Nothing
diff --git a/Yesod/Form/Class.hs b/Yesod/Form/Class.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Class.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+module Yesod.Form.Class
+    ( ToForm (..)
+    , ToFormField (..)
+    ) where
+
+import Text.Hamlet
+import Yesod.Form.Fields
+import Yesod.Form.Core
+import Yesod.Form.Profiles (Textarea)
+import Data.Int (Int64)
+import Data.Time (Day, TimeOfDay)
+
+class ToForm a y where
+    toForm :: Formlet sub y a
+class ToFormField a y where
+    toFormField :: FormFieldSettings -> FormletField sub y a
+
+instance ToFormField String y where
+    toFormField = stringField
+instance ToFormField (Maybe String) y where
+    toFormField = maybeStringField
+
+instance ToFormField Int y where
+    toFormField = intField
+instance ToFormField (Maybe Int) y where
+    toFormField = maybeIntField
+instance ToFormField Int64 y where
+    toFormField = intField
+instance ToFormField (Maybe Int64) y where
+    toFormField = maybeIntField
+
+instance ToFormField Double y where
+    toFormField = doubleField
+instance ToFormField (Maybe Double) y where
+    toFormField = maybeDoubleField
+
+instance ToFormField Day y where
+    toFormField = dayField
+instance ToFormField (Maybe Day) y where
+    toFormField = maybeDayField
+
+instance ToFormField TimeOfDay y where
+    toFormField = timeField
+instance ToFormField (Maybe TimeOfDay) y where
+    toFormField = maybeTimeField
+
+instance ToFormField Bool y where
+    toFormField = boolField
+
+instance ToFormField Html y where
+    toFormField = htmlField
+instance ToFormField (Maybe Html) y where
+    toFormField = maybeHtmlField
+
+instance ToFormField Textarea y where
+    toFormField = textareaField
+instance ToFormField (Maybe Textarea) y where
+    toFormField = maybeTextareaField
diff --git a/Yesod/Form/Core.hs b/Yesod/Form/Core.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Core.hs
@@ -0,0 +1,260 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Yesod.Form.Core
+    ( FormResult (..)
+    , GForm (..)
+    , newFormIdent
+    , deeperFormIdent
+    , shallowerFormIdent
+    , Env
+    , FileEnv
+    , Enctype (..)
+    , Ints (..)
+    , requiredFieldHelper
+    , optionalFieldHelper
+    , fieldsToInput
+    , mapFormXml
+    , checkForm
+    , askParams
+    , askFiles
+    , liftForm
+      -- * Data types
+    , FieldInfo (..)
+    , FormFieldSettings (..)
+    , FieldProfile (..)
+      -- * Type synonyms
+    , Form
+    , Formlet
+    , FormField
+    , FormletField
+    , FormInput
+    ) where
+
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Class (lift)
+import Yesod.Handler
+import Yesod.Widget
+import Data.Monoid (Monoid (..))
+import Control.Applicative
+import Yesod.Request
+import Control.Monad (liftM)
+import Text.Hamlet
+import Data.String
+import Control.Monad (join)
+
+-- | A form can produce three different results: there was no data available,
+-- the data was invalid, or there was a successful parse.
+--
+-- The 'Applicative' instance will concatenate the failure messages in two
+-- 'FormResult's.
+data FormResult a = FormMissing
+                  | FormFailure [String]
+                  | FormSuccess a
+    deriving Show
+instance Functor FormResult where
+    fmap _ FormMissing = FormMissing
+    fmap _ (FormFailure errs) = FormFailure errs
+    fmap f (FormSuccess a) = FormSuccess $ f a
+instance Applicative FormResult where
+    pure = FormSuccess
+    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
+    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
+    (FormFailure x) <*> _ = FormFailure x
+    _ <*> (FormFailure y) = FormFailure y
+    _ <*> _ = FormMissing
+instance Monoid m => Monoid (FormResult m) where
+    mempty = pure mempty
+    mappend x y = mappend <$> x <*> y
+
+-- | The encoding type required by a form. The 'Show' instance produces values
+-- that can be inserted directly into HTML.
+data Enctype = UrlEncoded | Multipart
+    deriving (Eq, Enum, Bounded)
+instance ToHtml Enctype where
+    toHtml UrlEncoded = unsafeByteString "application/x-www-form-urlencoded"
+    toHtml Multipart = unsafeByteString "multipart/form-data"
+instance Monoid Enctype where
+    mempty = UrlEncoded
+    mappend UrlEncoded UrlEncoded = UrlEncoded
+    mappend _ _ = Multipart
+
+data Ints = IntCons Int Ints | IntSingle Int
+instance Show Ints where
+    show (IntSingle i) = show i
+    show (IntCons i is) = show i ++ '-' : show is
+
+incrInts :: Ints -> Ints
+incrInts (IntSingle i) = IntSingle $ i + 1
+incrInts (IntCons i is) = (i + 1) `IntCons` is
+
+-- | A generic form, allowing you to specifying the subsite datatype, master
+-- site datatype, a datatype for the form XML and the return type.
+newtype GForm sub y xml a = GForm
+    { deform :: StateT Ints (
+                ReaderT Env (
+                ReaderT FileEnv (
+                (GHandler sub y)
+                ))) (FormResult a, xml, Enctype)
+    }
+
+type Env = [(String, String)]
+type FileEnv = [(String, FileInfo)]
+
+-- | Get a unique identifier.
+newFormIdent :: Monad m => StateT Ints m String
+newFormIdent = do
+    i <- get
+    let i' = incrInts i
+    put i'
+    return $ 'f' : show i'
+
+deeperFormIdent :: Monad m => StateT Ints m ()
+deeperFormIdent = do
+    i <- get
+    let i' = 1 `IntCons` incrInts i
+    put i'
+
+shallowerFormIdent :: Monad m => StateT Ints m ()
+shallowerFormIdent = do
+    IntCons _ i <- get
+    put i
+
+instance Monoid xml => Functor (GForm sub url xml) where
+    fmap f (GForm g) =
+        GForm $ liftM (first3 $ fmap f) g
+      where
+        first3 f' (x, y, z) = (f' x, y, z)
+
+instance Monoid xml => Applicative (GForm sub url xml) where
+    pure a = GForm $ return (pure a, mempty, mempty)
+    (GForm f) <*> (GForm g) = GForm $ do
+        (f1, f2, f3) <- f
+        (g1, g2, g3) <- g
+        return (f1 <*> g1, f2 `mappend` g2, f3 `mappend` g3)
+
+-- | Create a required field (ie, one that cannot be blank) from a
+-- 'FieldProfile'.ngs
+requiredFieldHelper :: FieldProfile sub y a -> FormFieldSettings
+                    -> Maybe a -> FormField sub y a
+requiredFieldHelper (FieldProfile parse render mkWidget) ffs orig = GForm $ do
+    env <- lift ask
+    let (FormFieldSettings label tooltip theId' name') = ffs
+    name <- maybe newFormIdent return name'
+    theId <- maybe newFormIdent return theId'
+    let (res, val) =
+            if null env
+                then (FormMissing, maybe "" render orig)
+                else case lookup name env of
+                        Nothing -> (FormMissing, "")
+                        Just "" -> (FormFailure ["Value is required"], "")
+                        Just x ->
+                            case parse x of
+                                Left e -> (FormFailure [e], x)
+                                Right y -> (FormSuccess y, x)
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = mkWidget theId name val True
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+-- | Create an optional field (ie, one that can be blank) from a
+-- 'FieldProfile'.
+optionalFieldHelper :: FieldProfile sub y a -> FormFieldSettings
+                    -> FormletField sub y (Maybe a)
+optionalFieldHelper (FieldProfile parse render mkWidget) ffs orig' = GForm $ do
+    env <- lift ask
+    let (FormFieldSettings label tooltip theId' name') = ffs
+    let orig = join orig'
+    name <- maybe newFormIdent return name'
+    theId <- maybe newFormIdent return theId'
+    let (res, val) =
+            if null env
+                then (FormSuccess Nothing, maybe "" render orig)
+                else case lookup name env of
+                        Nothing -> (FormSuccess Nothing, "")
+                        Just "" -> (FormSuccess Nothing, "")
+                        Just x ->
+                            case parse x of
+                                Left e -> (FormFailure [e], x)
+                                Right y -> (FormSuccess $ Just y, x)
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = mkWidget theId name val False
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+fieldsToInput :: [FieldInfo sub y] -> [GWidget sub y ()]
+fieldsToInput = map fiInput
+
+-- | Convert the XML in a 'GForm'.
+mapFormXml :: (xml1 -> xml2) -> GForm s y xml1 a -> GForm s y xml2 a
+mapFormXml f (GForm g) = GForm $ do
+    (res, xml, enc) <- g
+    return (res, f xml, enc)
+
+-- | Using this as the intermediate XML representation for fields allows us to
+-- write generic field functions and then different functions for producing
+-- actual HTML. See, for example, 'fieldsToTable' and 'fieldsToPlain'.
+data FieldInfo sub y = FieldInfo
+    { fiLabel :: Html
+    , fiTooltip :: Html
+    , fiIdent :: String
+    , fiName :: String
+    , fiInput :: GWidget sub y ()
+    , fiErrors :: Maybe Html
+    }
+
+data FormFieldSettings = FormFieldSettings
+    { ffsLabel :: Html
+    , ffsTooltip :: Html
+    , ffsId :: Maybe String
+    , ffsName :: Maybe String
+    }
+instance IsString FormFieldSettings where
+    fromString s = FormFieldSettings (string s) mempty Nothing Nothing
+
+-- | A generic definition of a form field that can be used for generating both
+-- required and optional fields. See 'requiredFieldHelper and
+-- 'optionalFieldHelper'.
+data FieldProfile sub y a = FieldProfile
+    { fpParse :: String -> Either String a
+    , fpRender :: a -> String
+    -- | ID, name, value, required
+    , fpWidget :: String -> String -> String -> Bool -> GWidget sub y ()
+    }
+
+type Form sub y = GForm sub y (GWidget sub y ())
+type Formlet sub y a = Maybe a -> Form sub y a
+type FormField sub y = GForm sub y [FieldInfo sub y]
+type FormletField sub y a = Maybe a -> FormField sub y a
+type FormInput sub y = GForm sub y [GWidget sub y ()]
+
+checkForm :: (a -> FormResult b) -> GForm s m x a -> GForm s m x b
+checkForm f (GForm form) = GForm $ do
+    (res, xml, enc) <- form
+    let res' = case res of
+                    FormSuccess a -> f a
+                    FormFailure e -> FormFailure e
+                    FormMissing -> FormMissing
+    return (res', xml, enc)
+
+askParams :: Monad m => StateT Ints (ReaderT Env m) Env
+askParams = lift ask
+
+askFiles :: Monad m => StateT Ints (ReaderT Env (ReaderT FileEnv m)) FileEnv
+askFiles = lift $ lift ask
+
+liftForm :: Monad m => m a -> StateT Ints (ReaderT Env (ReaderT FileEnv m)) a
+liftForm = lift . lift . lift
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Fields.hs
@@ -0,0 +1,268 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Yesod.Form.Fields
+    ( -- * Fields
+      -- ** Required
+      stringField
+    , textareaField
+    , hiddenField
+    , intField
+    , doubleField
+    , dayField
+    , timeField
+    , htmlField
+    , selectField
+    , boolField
+    , emailField
+    , urlField
+      -- ** Optional
+    , maybeStringField
+    , maybeTextareaField
+    , maybeHiddenField
+    , maybeIntField
+    , maybeDoubleField
+    , maybeDayField
+    , maybeTimeField
+    , maybeHtmlField
+    , maybeSelectField
+    , maybeEmailField
+    , maybeUrlField
+      -- * Inputs
+      -- ** Required
+    , stringInput
+    , intInput
+    , boolInput
+    , dayInput
+    , emailInput
+    , urlInput
+      -- ** Optional
+    , maybeStringInput
+    , maybeDayInput
+    ) where
+
+import Yesod.Form.Core
+import Yesod.Form.Profiles
+import Yesod.Widget
+import Data.Time (Day, TimeOfDay)
+import Text.Hamlet
+import Data.Monoid
+import Control.Monad (join)
+import Data.Maybe (fromMaybe)
+
+stringField :: FormFieldSettings -> FormletField sub y String
+stringField = requiredFieldHelper stringFieldProfile
+
+maybeStringField :: FormFieldSettings -> FormletField sub y (Maybe String)
+maybeStringField = optionalFieldHelper stringFieldProfile
+
+intInput :: Integral i => String -> FormInput sub master i
+intInput n =
+    mapFormXml fieldsToInput $
+    requiredFieldHelper intFieldProfile (nameSettings n) Nothing
+
+intField :: Integral i => FormFieldSettings -> FormletField sub y i
+intField = requiredFieldHelper intFieldProfile
+
+maybeIntField :: Integral i => FormFieldSettings -> FormletField sub y (Maybe i)
+maybeIntField = optionalFieldHelper intFieldProfile
+
+doubleField :: FormFieldSettings -> FormletField sub y Double
+doubleField = requiredFieldHelper doubleFieldProfile
+
+maybeDoubleField :: FormFieldSettings -> FormletField sub y (Maybe Double)
+maybeDoubleField = optionalFieldHelper doubleFieldProfile
+
+dayField :: FormFieldSettings -> FormletField sub y Day
+dayField = requiredFieldHelper dayFieldProfile
+
+maybeDayField :: FormFieldSettings -> FormletField sub y (Maybe Day)
+maybeDayField = optionalFieldHelper dayFieldProfile
+
+timeField :: FormFieldSettings -> FormletField sub y TimeOfDay
+timeField = requiredFieldHelper timeFieldProfile
+
+maybeTimeField :: FormFieldSettings -> FormletField sub y (Maybe TimeOfDay)
+maybeTimeField = optionalFieldHelper timeFieldProfile
+
+boolField :: FormFieldSettings -> Maybe Bool -> FormField sub y Bool
+boolField ffs orig = GForm $ do
+    env <- askParams
+    let label = ffsLabel ffs
+        tooltip = ffsTooltip ffs
+    name <- maybe newFormIdent return $ ffsName ffs
+    theId <- maybe newFormIdent return $ ffsId ffs
+    let (res, val) =
+            if null env
+                then (FormMissing, fromMaybe False orig)
+                else case lookup name env of
+                        Nothing -> (FormSuccess False, False)
+                        Just _ -> (FormSuccess True, True)
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = addBody [$hamlet|
+%input#$theId$!type=checkbox!name=$name$!:val:checked
+|]
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+htmlField :: FormFieldSettings -> FormletField sub y Html
+htmlField = requiredFieldHelper htmlFieldProfile
+
+maybeHtmlField :: FormFieldSettings -> FormletField sub y (Maybe Html)
+maybeHtmlField = optionalFieldHelper htmlFieldProfile
+
+selectField :: Eq x => [(x, String)]
+            -> FormFieldSettings
+            -> Maybe x -> FormField sub master x
+selectField pairs ffs initial = GForm $ do
+    env <- askParams
+    let label = ffsLabel ffs
+        tooltip = ffsTooltip ffs
+    theId <- maybe newFormIdent return $ ffsId ffs
+    name <- maybe newFormIdent return $ ffsName ffs
+    let pairs' = zip [1 :: Int ..] pairs
+    let res = case lookup name env of
+                Nothing -> FormMissing
+                Just "none" -> FormFailure ["Field is required"]
+                Just x ->
+                    case reads x of
+                        (x', _):_ ->
+                            case lookup x' pairs' of
+                                Nothing -> FormFailure ["Invalid entry"]
+                                Just (y, _) -> FormSuccess y
+                        [] -> FormFailure ["Invalid entry"]
+    let isSelected x =
+            case res of
+                FormSuccess y -> x == y
+                _ -> Just x == initial
+    let input = [$hamlet|
+%select#$theId$!name=$name$
+    %option!value=none
+    $forall pairs' pair
+        %option!value=$show.fst.pair$!:isSelected.fst.snd.pair:selected $snd.snd.pair$
+|]
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = addBody input
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+maybeSelectField :: Eq x => [(x, String)]
+                 -> FormFieldSettings
+                 -> FormletField sub master (Maybe x)
+maybeSelectField pairs ffs initial' = GForm $ do
+    env <- askParams
+    let initial = join initial'
+        label = ffsLabel ffs
+        tooltip = ffsTooltip ffs
+    theId <- maybe newFormIdent return $ ffsId ffs
+    name <- maybe newFormIdent return $ ffsName ffs
+    let pairs' = zip [1 :: Int ..] pairs
+    let res = case lookup name env of
+                Nothing -> FormMissing
+                Just "none" -> FormSuccess Nothing
+                Just x ->
+                    case reads x of
+                        (x', _):_ ->
+                            case lookup x' pairs' of
+                                Nothing -> FormFailure ["Invalid entry"]
+                                Just (y, _) -> FormSuccess $ Just y
+                        [] -> FormFailure ["Invalid entry"]
+    let isSelected x =
+            case res of
+                FormSuccess y -> Just x == y
+                _ -> Just x == initial
+    let input = [$hamlet|
+%select#$theId$!name=$name$
+    %option!value=none
+    $forall pairs' pair
+        %option!value=$show.fst.pair$!:isSelected.fst.snd.pair:selected $snd.snd.pair$
+|]
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = addBody input
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+stringInput :: String -> FormInput sub master String
+stringInput n =
+    mapFormXml fieldsToInput $
+    requiredFieldHelper stringFieldProfile (nameSettings n) Nothing
+
+maybeStringInput :: String -> FormInput sub master (Maybe String)
+maybeStringInput n =
+    mapFormXml fieldsToInput $
+    optionalFieldHelper stringFieldProfile (nameSettings n) Nothing
+
+boolInput :: String -> FormInput sub master Bool
+boolInput n = GForm $ do
+    env <- askParams
+    let res = FormSuccess $ fromMaybe "" (lookup n env) /= ""
+    let xml = addBody [$hamlet|
+%input#$n$!type=checkbox!name=$n$
+|]
+    return (res, [xml], UrlEncoded)
+
+dayInput :: String -> FormInput sub master Day
+dayInput n =
+    mapFormXml fieldsToInput $
+    requiredFieldHelper dayFieldProfile (nameSettings n) Nothing
+
+maybeDayInput :: String -> FormInput sub master (Maybe Day)
+maybeDayInput n =
+    mapFormXml fieldsToInput $
+    optionalFieldHelper dayFieldProfile (nameSettings n) Nothing
+
+nameSettings :: String -> FormFieldSettings
+nameSettings n = FormFieldSettings mempty mempty (Just n) (Just n)
+
+urlField :: FormFieldSettings -> FormletField sub y String
+urlField = requiredFieldHelper urlFieldProfile
+
+maybeUrlField :: FormFieldSettings -> FormletField sub y (Maybe String)
+maybeUrlField = optionalFieldHelper urlFieldProfile
+
+urlInput :: String -> FormInput sub master String
+urlInput n =
+    mapFormXml fieldsToInput $
+    requiredFieldHelper urlFieldProfile (nameSettings n) Nothing
+
+emailField :: FormFieldSettings -> FormletField sub y String
+emailField = requiredFieldHelper emailFieldProfile
+
+maybeEmailField :: FormFieldSettings -> FormletField sub y (Maybe String)
+maybeEmailField = optionalFieldHelper emailFieldProfile
+
+emailInput :: String -> FormInput sub master String
+emailInput n =
+    mapFormXml fieldsToInput $
+    requiredFieldHelper emailFieldProfile (nameSettings n) Nothing
+
+textareaField :: FormFieldSettings -> FormletField sub y Textarea
+textareaField = requiredFieldHelper textareaFieldProfile
+
+maybeTextareaField :: FormFieldSettings -> FormletField sub y (Maybe Textarea)
+maybeTextareaField = optionalFieldHelper textareaFieldProfile
+
+hiddenField :: FormFieldSettings -> FormletField sub y String
+hiddenField = requiredFieldHelper hiddenFieldProfile
+
+maybeHiddenField :: FormFieldSettings -> FormletField sub y (Maybe String)
+maybeHiddenField = optionalFieldHelper hiddenFieldProfile
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Jquery.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Yesod.Form.Jquery
+    ( YesodJquery (..)
+    , jqueryDayField
+    , maybeJqueryDayField
+    , jqueryDayTimeField
+    , jqueryDayTimeFieldProfile
+    , jqueryAutocompleteField
+    , maybeJqueryAutocompleteField
+    , jqueryDayFieldProfile
+    ) where
+
+import Yesod.Handler
+import Yesod.Form.Core
+import Yesod.Form.Profiles
+import Yesod.Widget
+import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
+                  timeToTimeOfDay)
+import Yesod.Hamlet
+import Data.Char (isSpace)
+
+class YesodJquery a where
+    -- | The jQuery Javascript file.
+    urlJqueryJs :: a -> Either (Route a) String
+    urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
+
+    -- | The jQuery UI 1.8.1 Javascript file.
+    urlJqueryUiJs :: a -> Either (Route a) String
+    urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
+
+    -- | The jQuery UI 1.8.1 CSS file; defaults to cupertino theme.
+    urlJqueryUiCss :: a -> Either (Route a) String
+    urlJqueryUiCss _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
+
+    -- | jQuery UI time picker add-on.
+    urlJqueryUiDateTimePicker :: a -> Either (Route a) String
+    urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
+
+jqueryDayField :: YesodJquery y => FormFieldSettings -> FormletField sub y Day
+jqueryDayField = requiredFieldHelper jqueryDayFieldProfile
+
+maybeJqueryDayField :: YesodJquery y => FormFieldSettings -> FormletField sub y (Maybe Day)
+maybeJqueryDayField = optionalFieldHelper jqueryDayFieldProfile
+
+jqueryDayFieldProfile :: YesodJquery y => FieldProfile sub y Day
+jqueryDayFieldProfile = FieldProfile
+    { fpParse = maybe
+                  (Left "Invalid day, must be in YYYY-MM-DD format")
+                  Right
+              . readMay
+    , fpRender = show
+    , fpWidget = \theId name val isReq -> do
+        addBody [$hamlet|
+%input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
+|]
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addStylesheet' urlJqueryUiCss
+        addJavascript [$julius|
+$(function(){$("#%theId%").datepicker({dateFormat:'yy-mm-dd'})});
+|]
+    }
+
+ifRight :: Either a b -> (b -> c) -> Either a c
+ifRight e f = case e of
+            Left l  -> Left l
+            Right r -> Right $ f r
+
+showLeadingZero :: (Show a) => a -> String
+showLeadingZero time = let t = show time in if length t == 1 then "0" ++ t else t
+
+jqueryDayTimeField :: YesodJquery y => FormFieldSettings -> FormletField sub y UTCTime
+jqueryDayTimeField = requiredFieldHelper jqueryDayTimeFieldProfile
+
+-- use A.M/P.M and drop seconds and "UTC" (as opposed to normal UTCTime show)
+jqueryDayTimeUTCTime :: UTCTime -> String
+jqueryDayTimeUTCTime (UTCTime day utcTime) =
+  let timeOfDay = timeToTimeOfDay utcTime
+  in (replace '-' '/' (show day)) ++ " " ++ showTimeOfDay timeOfDay
+  where
+    showTimeOfDay (TimeOfDay hour minute _) =
+      let (h, apm) = if hour < 12 then (hour, "AM") else (hour - 12, "PM")
+      in (show h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
+
+jqueryDayTimeFieldProfile :: YesodJquery y => FieldProfile sub y UTCTime
+jqueryDayTimeFieldProfile = FieldProfile
+    { fpParse  = parseUTCTime
+    , fpRender = jqueryDayTimeUTCTime
+    , fpWidget = \theId name val isReq -> do
+        addBody [$hamlet|
+%input#$theId$!name=$name$!:isReq:required!value=$val$
+|]
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addScript' urlJqueryUiDateTimePicker
+        addStylesheet' urlJqueryUiCss
+        addJavascript [$julius|
+$(function(){$("#%theId%").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})});
+|]
+    }
+
+parseUTCTime :: String -> Either String UTCTime
+parseUTCTime s =
+    let (dateS, timeS) = break isSpace (dropWhile isSpace s)
+        dateE = parseDate dateS
+     in case dateE of
+            Left l -> Left l
+            Right date ->
+                ifRight (parseTime timeS)
+                    (UTCTime date . timeOfDayToTime)
+
+jqueryAutocompleteField :: YesodJquery y =>
+    Route y -> FormFieldSettings -> FormletField sub y String
+jqueryAutocompleteField = requiredFieldHelper . jqueryAutocompleteFieldProfile
+
+maybeJqueryAutocompleteField :: YesodJquery y =>
+    Route y -> FormFieldSettings -> FormletField sub y (Maybe String)
+maybeJqueryAutocompleteField src =
+    optionalFieldHelper $ jqueryAutocompleteFieldProfile src
+
+jqueryAutocompleteFieldProfile :: YesodJquery y => Route y -> FieldProfile sub y String
+jqueryAutocompleteFieldProfile src = FieldProfile
+    { fpParse = Right
+    , fpRender = id
+    , fpWidget = \theId name val isReq -> do
+        addBody [$hamlet|
+%input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$
+|]
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addStylesheet' urlJqueryUiCss
+        addJavascript [$julius|
+$(function(){$("#%theId%").autocomplete({source:"@src@",minLength:2})});
+|]
+    }
+
+addScript' :: (y -> Either (Route y) String) -> GWidget sub y ()
+addScript' f = do
+    y <- liftHandler getYesod
+    addScriptEither $ f y
+
+addStylesheet' :: (y -> Either (Route y) String) -> GWidget sub y ()
+addStylesheet' f = do
+    y <- liftHandler getYesod
+    addStylesheetEither $ f y
+
+readMay :: Read a => String -> Maybe a
+readMay s = case reads s of
+                (x, _):_ -> Just x
+                [] -> Nothing
+
+-- | Replaces all instances of a value in a list by another value.
+-- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
+replace :: Eq a => a -> a -> [a] -> [a]
+replace x y = map (\z -> if z == x then y else z)
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Nic.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Yesod.Form.Nic
+    ( YesodNic (..)
+    , nicHtmlField
+    , maybeNicHtmlField
+    ) where
+
+import Yesod.Handler
+import Yesod.Form.Core
+import Yesod.Hamlet
+import Yesod.Widget
+import qualified Data.ByteString.Lazy.UTF8 as U
+
+class YesodNic a where
+    -- | NIC Editor.
+    urlNicEdit :: a -> Either (Route a) String
+    urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
+
+nicHtmlField :: YesodNic y => FormFieldSettings -> FormletField sub y Html
+nicHtmlField = requiredFieldHelper nicHtmlFieldProfile
+
+maybeNicHtmlField :: YesodNic y => FormFieldSettings -> FormletField sub y (Maybe Html)
+maybeNicHtmlField = optionalFieldHelper nicHtmlFieldProfile
+
+nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html
+nicHtmlFieldProfile = FieldProfile
+    { fpParse = Right . preEscapedString
+    , fpRender = U.toString . renderHtml
+    , fpWidget = \theId name val _isReq -> do
+        addBody [$hamlet|%textarea.html#$theId$!name=$name$ $val$|]
+        addScript' urlNicEdit
+        addJavascript [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("%theId%")});|]
+    }
+
+addScript' :: (y -> Either (Route y) String) -> GWidget sub y ()
+addScript' f = do
+    y <- liftHandler getYesod
+    addScriptEither $ f y
diff --git a/Yesod/Form/Profiles.hs b/Yesod/Form/Profiles.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Profiles.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Yesod.Form.Profiles
+    ( stringFieldProfile
+    , textareaFieldProfile
+    , hiddenFieldProfile
+    , intFieldProfile
+    , dayFieldProfile
+    , timeFieldProfile
+    , htmlFieldProfile
+    , emailFieldProfile
+    , urlFieldProfile
+    , doubleFieldProfile
+    , fileFieldProfile
+    , parseDate
+    , parseTime
+    , Textarea (..)
+    ) where
+
+import Yesod.Form.Core
+import Yesod.Widget
+import Yesod.Request
+import Text.Hamlet
+import Data.Time (Day, TimeOfDay(..))
+import qualified Data.ByteString.Lazy.UTF8 as U
+import qualified Text.Email.Validate as Email
+import Network.URI (parseURI)
+import Database.Persist (PersistField)
+
+import Text.Blaze.Builder.Utf8 (writeChar)
+import Text.Blaze.Builder.Core (writeList, writeByteString)
+
+intFieldProfile :: Integral i => FieldProfile sub y i
+intFieldProfile = FieldProfile
+    { fpParse = maybe (Left "Invalid integer") Right . readMayI
+    , fpRender = showI
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!type=number!:isReq:required!value=$val$
+|]
+    }
+  where
+    showI x = show (fromIntegral x :: Integer)
+    readMayI s = case reads s of
+                    (x, _):_ -> Just $ fromInteger x
+                    [] -> Nothing
+
+doubleFieldProfile :: FieldProfile sub y Double
+doubleFieldProfile = FieldProfile
+    { fpParse = maybe (Left "Invalid number") Right . readMay
+    , fpRender = show
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!type=number!:isReq:required!value=$val$
+|]
+    }
+
+fileFieldProfile :: FieldProfile s m FileInfo
+fileFieldProfile = undefined -- FIXME
+
+dayFieldProfile :: FieldProfile sub y Day
+dayFieldProfile = FieldProfile
+    { fpParse = parseDate
+    , fpRender = show
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
+|]
+    }
+
+timeFieldProfile :: FieldProfile sub y TimeOfDay
+timeFieldProfile = FieldProfile
+    { fpParse = parseTime
+    , fpRender = show
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!:isReq:required!value=$val$
+|]
+    }
+
+htmlFieldProfile :: FieldProfile sub y Html
+htmlFieldProfile = FieldProfile
+    { fpParse = Right . preEscapedString
+    , fpRender = U.toString . renderHtml
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
+%textarea.html#$theId$!name=$name$ $val$
+|]
+    }
+
+-- | A newtype wrapper around a 'String' that converts newlines to HTML
+-- br-tags.
+newtype Textarea = Textarea { unTextarea :: String }
+    deriving (Show, Read, Eq, PersistField)
+instance ToHtml Textarea where
+    toHtml =
+        Html . writeList writeHtmlEscapedChar . unTextarea
+      where
+        -- Taken from blaze-builder and modified with newline handling.
+        writeHtmlEscapedChar '<'  = writeByteString "&lt;"
+        writeHtmlEscapedChar '>'  = writeByteString "&gt;"
+        writeHtmlEscapedChar '&'  = writeByteString "&amp;"
+        writeHtmlEscapedChar '"'  = writeByteString "&quot;"
+        writeHtmlEscapedChar '\'' = writeByteString "&apos;"
+        writeHtmlEscapedChar '\n' = writeByteString "<br>"
+        writeHtmlEscapedChar c    = writeChar c
+
+textareaFieldProfile :: FieldProfile sub y Textarea
+textareaFieldProfile = FieldProfile
+    { fpParse = Right . Textarea
+    , fpRender = unTextarea
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
+%textarea#$theId$!name=$name$ $val$
+|]
+    }
+
+hiddenFieldProfile :: FieldProfile sub y String
+hiddenFieldProfile = FieldProfile
+    { fpParse = Right
+    , fpRender = id
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
+%input!type=hidden#$theId$!name=$name$!value=$val$
+|]
+    }
+
+stringFieldProfile :: FieldProfile sub y String
+stringFieldProfile = FieldProfile
+    { fpParse = Right
+    , fpRender = id
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!type=text!:isReq:required!value=$val$
+|]
+    }
+
+readMay :: Read a => String -> Maybe a
+readMay s = case reads s of
+                (x, _):_ -> Just x
+                [] -> Nothing
+
+parseDate :: String -> Either String Day
+parseDate = maybe (Left "Invalid day, must be in YYYY-MM-DD format") Right
+              . readMay . replace '/' '-'
+
+-- | Replaces all instances of a value in a list by another value.
+-- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
+replace :: Eq a => a -> a -> [a] -> [a]
+replace x y = map (\z -> if z == x then y else z)
+
+parseTime :: String -> Either String TimeOfDay
+parseTime (h2:':':m1:m2:[]) = parseTimeHelper ('0', h2, m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:[]) = parseTimeHelper (h1, h2, m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:' ':'A':'M':[]) =
+    parseTimeHelper (h1, h2, m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:' ':'P':'M':[]) =
+    let [h1', h2'] = show $ (read [h1, h2] :: Int) + 12
+    in parseTimeHelper (h1', h2', m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:':':s1:s2:[]) =
+    parseTimeHelper (h1, h2, m1, m2, s1, s2)
+parseTime _ = Left "Invalid time, must be in HH:MM[:SS] format"
+
+parseTimeHelper :: (Char, Char, Char, Char, Char, Char)
+                -> Either [Char] TimeOfDay
+parseTimeHelper (h1, h2, m1, m2, s1, s2)
+    | h < 0 || h > 23 = Left $ "Invalid hour: " ++ show h
+    | m < 0 || m > 59 = Left $ "Invalid minute: " ++ show m
+    | s < 0 || s > 59 = Left $ "Invalid second: " ++ show s
+    | otherwise = Right $ TimeOfDay h m s
+  where
+    h = read [h1, h2]
+    m = read [m1, m2]
+    s = fromInteger $ read [s1, s2]
+
+emailFieldProfile :: FieldProfile s y String
+emailFieldProfile = FieldProfile
+    { fpParse = \s -> if Email.isValid s
+                        then Right s
+                        else Left "Invalid e-mail address"
+    , fpRender = id
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!type=email!:isReq:required!value=$val$
+|]
+    }
+
+urlFieldProfile :: FieldProfile s y String
+urlFieldProfile = FieldProfile
+    { fpParse = \s -> case parseURI s of
+                        Nothing -> Left "Invalid URL"
+                        Just _ -> Right s
+    , fpRender = id
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
+%input#$theId$!name=$name$!type=url!:isReq:required!value=$val$
+|]
+    }
diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs
--- a/Yesod/Hamlet.hs
+++ b/Yesod/Hamlet.hs
@@ -5,7 +5,24 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Yesod.Hamlet
     ( -- * Hamlet library
-      module Text.Hamlet
+      -- ** Hamlet
+      hamlet
+    , xhamlet
+    , Hamlet
+    , Html
+    , renderHamlet
+    , renderHtml
+    , string
+    , preEscapedString
+    , cdata
+      -- ** Julius
+    , julius
+    , Julius
+    , renderJulius
+      -- ** Cassius
+    , cassius
+    , Cassius
+    , renderCassius
       -- * Convert to something displayable
     , hamletToContent
     , hamletToRepHtml
@@ -15,6 +32,8 @@
     where
 
 import Text.Hamlet
+import Text.Cassius
+import Text.Julius
 import Yesod.Content
 import Yesod.Handler
 
@@ -23,7 +42,7 @@
 --
 -- > PageContent url -> Hamlet url
 data PageContent url = PageContent
-    { pageTitle :: Html ()
+    { pageTitle :: Html
     , pageHead :: Hamlet url
     , pageBody :: Hamlet url
     }
@@ -32,7 +51,7 @@
 -- Yesod 'Response'.
 hamletToContent :: Hamlet (Route master) -> GHandler sub master Content
 hamletToContent h = do
-    render <- getUrlRender
+    render <- getUrlRenderParams
     return $ toContent $ renderHamlet render h
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -24,12 +24,12 @@
     ( -- * Type families
       Route
       -- * Handler monad
-    , Handler
     , GHandler
       -- ** Read information from handler
     , getYesod
     , getYesodSub
     , getUrlRender
+    , getUrlRenderParams
     , getCurrentRoute
     , getRouteToMaster
       -- * Special responses
@@ -66,13 +66,14 @@
     , runHandler
     , YesodApp (..)
     , toMasterHandler
+    , localNoCurrent
     ) where
 
 import Prelude hiding (catch)
 import Yesod.Request
 import Yesod.Content
 import Yesod.Internal
-import Data.List (foldl', intercalate)
+import Data.List (foldl')
 import Data.Neither
 
 import Control.Exception hiding (Handler, catch)
@@ -92,8 +93,6 @@
 import qualified Data.ByteString.Lazy.UTF8 as L
 
 import Text.Hamlet
-import Numeric (showIntAtBase)
-import Data.Char (ord, chr)
 
 -- | The type-safe URLs associated with a site argument.
 type family Route a
@@ -103,7 +102,7 @@
     , handlerSub :: sub
     , handlerMaster :: master
     , handlerRoute :: Maybe (Route sub)
-    , handlerRender :: (Route master -> String)
+    , handlerRender :: (Route master -> [(String, String)] -> String)
     , handlerToMaster :: Route sub -> Route master
     }
 
@@ -124,7 +123,7 @@
                 -> (master -> sub)
                 -> Route sub
                 -> GHandler sub master a
-                -> Handler master a
+                -> GHandler master master a
 toMasterHandler tm ts route (GHandler h) =
     GHandler $ withReaderT (handlerSubData tm ts route) h
 
@@ -145,11 +144,6 @@
 
 type Endo a = a -> a
 
--- | A 'GHandler' limited to the case where the master and sub sites are the
--- same. This is the usual case for application writing; only code written
--- specifically as a subsite need been concerned with the more general variety.
-type Handler yesod = GHandler yesod yesod
-
 -- | An extension of the basic WAI 'W.Application' datatype to provide extra
 -- features needed by Yesod. Users should never need to use this directly, as
 -- the 'GHandler' monad and template haskell code should hide it away.
@@ -182,8 +176,14 @@
 
 -- | Get the URL rendering function.
 getUrlRender :: GHandler sub master (Route master -> String)
-getUrlRender = handlerRender <$> GHandler ask
+getUrlRender = do
+    x <- handlerRender <$> GHandler ask
+    return $ flip x []
 
+-- | The URL rendering function with query-string parameters.
+getUrlRenderParams :: GHandler sub master (Route master -> [(String, String)] -> String)
+getUrlRenderParams = handlerRender <$> GHandler ask
+
 -- | Get the route requested by the user. If this is a 404 response- where the
 -- user requested an invalid route- this function will return 'Nothing'.
 getCurrentRoute :: GHandler sub master (Maybe (Route sub))
@@ -208,7 +208,7 @@
 -- 'GHandler' into an 'W.Application'. Should not be needed by users.
 runHandler :: HasReps c
            => GHandler sub master c
-           -> (Route master -> String)
+           -> (Route master -> [(String, String)] -> String)
            -> Maybe (Route sub)
            -> (Route sub -> Route master)
            -> master
@@ -267,29 +267,8 @@
 redirectParams :: RedirectType -> Route master -> [(String, String)]
                -> GHandler sub master a
 redirectParams rt url params = do
-    r <- getUrlRender
-    redirectString rt $ r url ++
-        if null params then "" else '?' : encodeUrlPairs params
-  where
-    encodeUrlPairs = intercalate "&" . map encodeUrlPair
-    encodeUrlPair (x, []) = escape x
-    encodeUrlPair (x, y) = escape x ++ '=' : escape y
-    escape = concatMap escape'
-    escape' c
-        | 'A' < c && c < 'Z' = [c]
-        | 'a' < c && c < 'a' = [c]
-        | '0' < c && c < '9' = [c]
-        | c `elem` ".-~_" = [c]
-        | c == ' ' = "+"
-        | otherwise = '%' : myShowHex (ord c) ""
-    myShowHex :: Int -> ShowS
-    myShowHex n r =  case showIntAtBase 16 toChrHex n r of
-        []  -> "00"
-        [c] -> ['0',c]
-        s  -> s
-    toChrHex d
-        | d < 10    = chr (ord '0' + fromIntegral d)
-        | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+    r <- getUrlRenderParams
+    redirectString rt $ r url params
 
 -- | Redirect to the given URL.
 redirectString :: RedirectType -> String -> GHandler sub master a
@@ -318,8 +297,13 @@
 setUltDest' :: GHandler sub master ()
 setUltDest' = do
     route <- getCurrentRoute
-    tm <- getRouteToMaster
-    maybe (return ()) setUltDest $ tm <$> route
+    case route of
+        Nothing -> return ()
+        Just r -> do
+            tm <- getRouteToMaster
+            gets <- reqGetParams <$> getRequest
+            render <- getUrlRenderParams
+            setUltDestString $ render (tm r) gets
 
 -- | Redirect to the ultimate destination in the user's session. Clear the
 -- value from the session.
@@ -342,14 +326,14 @@
 -- instead, it will only appear in the next request.
 --
 -- See 'getMessage'.
-setMessage :: Html () -> GHandler sub master ()
+setMessage :: Html -> GHandler sub master ()
 setMessage = setSession msgKey . L.toString . renderHtml
 
 -- | Gets the message in the user's session, if available, and then clears the
 -- variable.
 --
 -- See 'setMessage'.
-getMessage :: GHandler sub master (Maybe (Html ()))
+getMessage :: GHandler sub master (Maybe Html)
 getMessage = do
     deleteSession msgKey
     fmap (fmap preEscapedString) $ lookupSession msgKey
@@ -438,3 +422,7 @@
                   | RedirectTemporary
                   | RedirectSeeOther
     deriving (Show, Eq)
+
+localNoCurrent :: GHandler s m a -> GHandler s m a
+localNoCurrent =
+    GHandler . local (\hd -> hd { handlerRoute = Nothing }) . unGHandler
diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs
--- a/Yesod/Helpers/AtomFeed.hs
+++ b/Yesod/Helpers/AtomFeed.hs
@@ -44,7 +44,7 @@
     { atomEntryLink :: url
     , atomEntryUpdated :: UTCTime
     , atomEntryTitle :: String
-    , atomEntryContent :: Html ()
+    , atomEntryContent :: Html
     }
 
 template :: AtomFeed url -> Hamlet url
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -6,6 +7,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE OverloadedStrings #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Helpers.Auth
@@ -22,17 +24,22 @@
 module Yesod.Helpers.Auth
     ( -- * Subsite
       Auth (..)
+    , getAuth
     , AuthRoute (..)
       -- * Settings
     , YesodAuth (..)
     , Creds (..)
     , EmailCreds (..)
     , AuthType (..)
-    , AuthEmailSettings (..)
-    , inMemoryEmailSettings
+    , RpxnowSettings (..)
+    , EmailSettings (..)
+    , FacebookSettings (..)
+    , getFacebookUrl
       -- * Functions
-    , maybeCreds
-    , requireCreds
+    , maybeAuth
+    , maybeAuthId
+    , requireAuth
+    , requireAuthId
     ) where
 
 import qualified Web.Authenticate.Rpxnow as Rpxnow
@@ -40,33 +47,35 @@
 import qualified Web.Authenticate.Facebook as Facebook
 
 import Yesod
+import Yesod.Mail (randomString)
 
 import Data.Maybe
+import Data.Int (Int64)
 import Control.Monad
 import System.Random
 import Data.Digest.Pure.MD5
 import Control.Applicative
-import Control.Concurrent.MVar
-import System.IO
 import Control.Monad.Attempt
 import Data.ByteString.Lazy.UTF8 (fromString)
 import Data.Object
+import Language.Haskell.TH.Syntax
 
--- | Minimal complete definition: 'defaultDest' and 'defaultLoginRoute'.
-class Yesod master => YesodAuth master where
+type AuthId m = Key (AuthEntity m)
+type AuthEmailId m = Key (AuthEmailEntity m)
+
+class ( Yesod master
+      , PersistEntity (AuthEntity master)
+      , PersistEntity (AuthEmailEntity master)
+      ) => YesodAuth master where
+    type AuthEntity master
+    type AuthEmailEntity master
+
     -- | Default destination on successful login or logout, if no other
     -- destination exists.
     defaultDest :: master -> Route master
 
-    -- | Default page to redirect user to for logging in.
-    defaultLoginRoute :: master -> Route master
-
-    -- | Callback for a successful login.
-    --
-    -- The second parameter can contain various information, depending on login
-    -- mechanism.
-    onLogin :: Creds -> [(String, String)] -> GHandler Auth master ()
-    onLogin _ _ = return ()
+    getAuthId :: Creds master -> [(String, String)]
+              -> GHandler s master (Maybe (AuthId master))
 
     -- | Generate a random alphanumeric string.
     --
@@ -74,19 +83,26 @@
     randomKey :: master -> IO String
     randomKey _ = do
         stdgen <- newStdGen
-        return $ take 10 $ randomRs ('A', 'Z') stdgen
+        return $ fst $ randomString 10 stdgen
 
--- | Each authentication subsystem (OpenId, Rpxnow, Email, Facebook) has its
--- own settings. If those settings are not present, then relevant handlers will
--- simply return a 404.
-data Auth = Auth
-    { authIsOpenIdEnabled :: Bool
-    , authRpxnowApiKey :: Maybe String
-    , authEmailSettings :: Maybe AuthEmailSettings
+    openIdEnabled :: master -> Bool
+    openIdEnabled _ = False
+
+    rpxnowSettings :: master -> Maybe RpxnowSettings
+    rpxnowSettings _ = Nothing
+
+    emailSettings :: master -> Maybe (EmailSettings master)
+    emailSettings _ = Nothing
+
     -- | client id, secret and requested permissions
-    , authFacebook :: Maybe (String, String, [String])
-    }
+    facebookSettings :: master -> Maybe FacebookSettings
+    facebookSettings _ = Nothing
 
+data Auth = Auth
+
+getAuth :: a -> Auth
+getAuth = const Auth
+
 -- | Which subsystem authenticated the user.
 data AuthType = AuthOpenId | AuthRpxnow | AuthEmail | AuthFacebook
     deriving (Show, Read, Eq)
@@ -94,109 +110,127 @@
 type Email = String
 type VerKey = String
 type VerUrl = String
-type EmailId = Integer
 type SaltedPass = String
 type VerStatus = Bool
 
 -- | Data stored in a database for each e-mail address.
-data EmailCreds = EmailCreds EmailId (Maybe SaltedPass) VerStatus VerKey
+data EmailCreds m = EmailCreds
+    { emailCredsId :: AuthEmailId m
+    , emailCredsAuthId :: Maybe (AuthId m)
+    , emailCredsStatus :: VerStatus
+    , emailCredsVerkey :: Maybe VerKey
+    }
 
--- | For a sample set of settings for a trivial in-memory database, see
--- 'inMemoryEmailSettings'.
-data AuthEmailSettings = AuthEmailSettings
-    { addUnverified :: Email -> VerKey -> IO EmailId
-    , sendVerifyEmail :: Email -> VerKey -> VerUrl -> IO ()
-    , getVerifyKey :: EmailId -> IO (Maybe VerKey)
-    , verifyAccount :: EmailId -> IO ()
-    , setPassword :: EmailId -> String -> IO ()
-    , getEmailCreds :: Email -> IO (Maybe EmailCreds)
-    , getEmail :: EmailId -> IO (Maybe Email)
+data RpxnowSettings = RpxnowSettings
+    { rpxnowApp :: String
+    , rpxnowKey :: String
     }
 
+data EmailSettings m = EmailSettings
+    { addUnverified :: Email -> VerKey -> GHandler Auth m (AuthEmailId m)
+    , sendVerifyEmail :: Email -> VerKey -> VerUrl -> GHandler Auth m ()
+    , getVerifyKey :: AuthEmailId m -> GHandler Auth m (Maybe VerKey)
+    , setVerifyKey :: AuthEmailId m -> VerKey -> GHandler Auth m ()
+    , verifyAccount :: AuthEmailId m -> GHandler Auth m (Maybe (AuthId m))
+    , getPassword :: AuthId m -> GHandler Auth m (Maybe SaltedPass)
+    , setPassword :: AuthId m -> SaltedPass -> GHandler Auth m ()
+    , getEmailCreds :: Email -> GHandler Auth m (Maybe (EmailCreds m))
+    , getEmail :: AuthEmailId m -> GHandler Auth m (Maybe Email)
+    }
+
+data FacebookSettings = FacebookSettings
+    { fbAppId :: String
+    , fbSecret :: String
+    , fbPerms :: [String]
+    }
+
 -- | User credentials
-data Creds = Creds
+data Creds m = Creds
     { credsIdent :: String -- ^ Identifier. Exact meaning depends on 'credsAuthType'.
     , credsAuthType :: AuthType -- ^ How the user was authenticated
     , credsEmail :: Maybe String -- ^ Verified e-mail address.
     , credsDisplayName :: Maybe String -- ^ Display name.
-    , credsId :: Maybe Integer -- ^ Numeric ID, if used.
+    , credsId :: Maybe (AuthId m) -- ^ Numeric ID, if used.
     , credsFacebookToken :: Maybe Facebook.AccessToken
     }
-    deriving (Show, Read, Eq)
 
 credsKey :: String
-credsKey = "_CREDS"
+credsKey = "_ID"
 
 setCreds :: YesodAuth master
-         => Creds -> [(String, String)] -> GHandler Auth master ()
+         => Creds master -> [(String, String)] -> GHandler Auth master ()
 setCreds creds extra = do
-    setSession credsKey $ show creds
-    onLogin creds extra
+    maid <- getAuthId creds extra
+    case maid of
+        Nothing -> return ()
+        Just aid -> setSession credsKey $ show $ fromPersistKey aid
 
 -- | Retrieves user credentials, if user is authenticated.
-maybeCreds :: RequestReader r => r (Maybe Creds)
-maybeCreds = do
-    mstring <- lookupSession credsKey
-    return $ mstring >>= readMay
-  where
-    readMay x = case reads x of
-                    (y, _):_ -> Just y
-                    _ -> Nothing
+maybeAuthId :: YesodAuth m => GHandler s m (Maybe (AuthId m))
+maybeAuthId = do
+    ms <- lookupSession credsKey
+    case ms of
+        Nothing -> return Nothing
+        Just s -> case reads s of
+                    [] -> return Nothing
+                    (i, _):_ -> return $ Just $ toPersistKey i
 
-mkYesodSub "Auth" [("master", [''YesodAuth])] [$parseRoutes|
-/check                   Check              GET
-/logout                  Logout             GET
-/openid                  OpenIdR            GET
-/openid/forward          OpenIdForward      GET
-/openid/complete         OpenIdComplete     GET
+maybeAuth :: ( PersistBackend (YesodDB m (GHandler s m))
+             , YesodPersist m
+             , YesodAuth m
+             ) => GHandler s m (Maybe (AuthId m, AuthEntity m))
+maybeAuth = do
+    maid <- maybeAuthId
+    case maid of
+        Nothing -> return Nothing
+        Just aid -> do
+            ma <- runDB $ get aid
+            case ma of
+                Nothing -> return Nothing
+                Just a -> return $ Just (aid, a)
+
+mkYesodSub "Auth"
+    [ ClassP ''YesodAuth [VarT $ mkName "master"]
+    ]
+    [$parseRoutes|
+/check                   CheckR             GET
+/logout                  LogoutR            GET
+/openid/forward          OpenIdForwardR     GET
+/openid/complete         OpenIdCompleteR    GET
 /login/rpxnow            RpxnowR
 
 /facebook                FacebookR          GET
-/facebook/start          StartFacebookR     GET
 
 /register                EmailRegisterR     GET POST
-/verify/#Integer/#String EmailVerifyR       GET
-/login                   EmailLoginR        GET POST
+/verify/#Int64/#String   EmailVerifyR       GET
+/email-login             EmailLoginR        POST
 /set-password            EmailPasswordR     GET POST
+
+/login                   LoginR             GET
 |]
 
-testOpenId :: GHandler Auth master ()
+testOpenId :: YesodAuth master => GHandler Auth master ()
 testOpenId = do
-    a <- getYesodSub
-    unless (authIsOpenIdEnabled a) notFound
-
-getOpenIdR :: Yesod master => GHandler Auth master RepHtml
-getOpenIdR = do
-    testOpenId
-    lookupGetParam "dest" >>= maybe (return ()) setUltDestString
-    rtom <- getRouteToMaster
-    message <- getMessage
-    applyLayout "Log in via OpenID" mempty [$hamlet|
-$maybe message msg
-    %p.message $msg$
-%form!method=get!action=@rtom.OpenIdForward@
-    %label!for=openid OpenID: $
-    %input#openid!type=text!name=openid
-    %input!type=submit!value=Login
-|]
+    a <- getYesod
+    unless (openIdEnabled a) notFound
 
-getOpenIdForward :: GHandler Auth master ()
-getOpenIdForward = do
+getOpenIdForwardR :: YesodAuth master => GHandler Auth master ()
+getOpenIdForwardR = do
     testOpenId
     oid <- runFormGet' $ stringInput "openid"
     render <- getUrlRender
     toMaster <- getRouteToMaster
-    let complete = render $ toMaster OpenIdComplete
+    let complete = render $ toMaster OpenIdCompleteR
     res <- runAttemptT $ OpenId.getForwardUrl oid complete
     attempt
       (\err -> do
             setMessage $ string $ show err
-            redirect RedirectTemporary $ toMaster OpenIdR)
+            redirect RedirectTemporary $ toMaster LoginR)
       (redirectString RedirectTemporary)
       res
 
-getOpenIdComplete :: YesodAuth master => GHandler Auth master ()
-getOpenIdComplete = do
+getOpenIdCompleteR :: YesodAuth master => GHandler Auth master ()
+getOpenIdCompleteR = do
     testOpenId
     rr <- getRequest
     let gets' = reqGetParams rr
@@ -204,7 +238,7 @@
     toMaster <- getRouteToMaster
     let onFailure err = do
         setMessage $ string $ show err
-        redirect RedirectTemporary $ toMaster OpenIdR
+        redirect RedirectTemporary $ toMaster LoginR
     let onSuccess (OpenId.Identifier ident) = do
         y <- getYesod
         setCreds (Creds ident AuthOpenId Nothing Nothing Nothing Nothing) []
@@ -214,8 +248,8 @@
 handleRpxnowR :: YesodAuth master => GHandler Auth master ()
 handleRpxnowR = do
     ay <- getYesod
-    auth <- getYesodSub
-    apiKey <- case authRpxnowApiKey auth of
+    auth <- getYesod
+    apiKey <- case rpxnowKey <$> rpxnowSettings auth of
                 Just x -> return x
                 Nothing -> notFound
     token1 <- lookupGetParam "token"
@@ -248,51 +282,60 @@
   where
     choices = ["verifiedEmail", "email", "displayName", "preferredUsername"]
 
-getCheck :: Yesod master => GHandler Auth master RepHtmlJson
-getCheck = do
-    creds <- maybeCreds
-    applyLayoutJson "Authentication Status" mempty (html creds) (json creds)
+getCheckR :: YesodAuth master => GHandler Auth master RepHtmlJson
+getCheckR = do
+    creds <- maybeAuthId
+    defaultLayoutJson (do
+        setTitle "Authentication Status"
+        addBody $ html creds) (json creds)
   where
     html creds = [$hamlet|
 %h1 Authentication Status
 $if isNothing.creds
-    %p Not logged in
-$maybe creds c
-    %p Logged in as $credsIdent.c$
+    %p Not logged in.
+$maybe creds _
+    %p Logged in.
 |]
     json creds =
         jsonMap
-            [ ("ident", jsonScalar $ maybe (string "") (string . credsIdent) creds)
-            , ("displayName", jsonScalar $ string $ fromMaybe ""
-                                         $ creds >>= credsDisplayName)
+            [ ("logged_in", jsonScalar $ maybe "false" (const "true") creds)
             ]
 
-getLogout :: YesodAuth master => GHandler Auth master ()
-getLogout = do
+getLogoutR :: YesodAuth master => GHandler Auth master ()
+getLogoutR = do
     y <- getYesod
     deleteSession credsKey
     redirectUltDest RedirectTemporary $ defaultDest y
 
 -- | Retrieve user credentials. If user is not logged in, redirects to the
--- 'defaultLoginRoute'. Sets ultimate destination to current route, so user
+-- 'authRoute'. Sets ultimate destination to current route, so user
 -- should be sent back here after authenticating.
-requireCreds :: YesodAuth master => GHandler sub master Creds
-requireCreds =
-    maybeCreds >>= maybe redirectLogin return
-  where
-    redirectLogin = do
-        y <- getYesod
-        setUltDest'
-        redirect RedirectTemporary $ defaultLoginRoute y
+requireAuthId :: YesodAuth m => GHandler sub m (AuthId m)
+requireAuthId = maybeAuthId >>= maybe redirectLogin return
 
-getAuthEmailSettings :: GHandler Auth master AuthEmailSettings
-getAuthEmailSettings = getYesodSub >>= maybe notFound return . authEmailSettings
+requireAuth :: ( PersistBackend (YesodDB m (GHandler s m))
+               , YesodPersist m
+               , YesodAuth m
+               ) => GHandler s m (AuthId m, AuthEntity m)
+requireAuth = maybeAuth >>= maybe redirectLogin return
 
-getEmailRegisterR :: Yesod master => GHandler Auth master RepHtml
+redirectLogin :: Yesod m => GHandler s m a
+redirectLogin = do
+    y <- getYesod
+    setUltDest'
+    case authRoute y of
+        Just z -> redirect RedirectTemporary z
+        Nothing -> permissionDenied "Please configure authRoute"
+
+getEmailSettings :: YesodAuth master
+                     => GHandler Auth master (EmailSettings master)
+getEmailSettings = getYesod >>= maybe notFound return . emailSettings
+
+getEmailRegisterR :: YesodAuth master => GHandler Auth master RepHtml
 getEmailRegisterR = do
-    _ae <- getAuthEmailSettings
+    _ae <- getEmailSettings
     toMaster <- getRouteToMaster
-    applyLayout "Register a new account" mempty [$hamlet|
+    defaultLayout $ setTitle "Register a new account" >> addBody [$hamlet|
 %p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
 %form!method=post!action=@toMaster.EmailRegisterR@
     %label!for=email E-mail
@@ -302,105 +345,96 @@
 
 postEmailRegisterR :: YesodAuth master => GHandler Auth master RepHtml
 postEmailRegisterR = do
-    ae <- getAuthEmailSettings
+    ae <- getEmailSettings
     email <- runFormPost' $ emailInput "email"
-    y <- getYesod
-    mecreds <- liftIO $ getEmailCreds ae email
+    mecreds <- getEmailCreds ae email
     (lid, verKey) <-
         case mecreds of
-            Nothing -> liftIO $ do
-                key <- randomKey y
+            Just (EmailCreds lid _ _ (Just key)) -> return (lid, key)
+            Just (EmailCreds lid _ _ Nothing) -> do
+                y <- getYesod
+                key <- liftIO $ randomKey y
+                setVerifyKey ae lid key
+                return (lid, key)
+            Nothing -> do
+                y <- getYesod
+                key <- liftIO $ randomKey y
                 lid <- addUnverified ae email key
                 return (lid, key)
-            Just (EmailCreds lid _ _ key) -> return (lid, key)
     render <- getUrlRender
     tm <- getRouteToMaster
-    let verUrl = render $ tm $ EmailVerifyR lid verKey
-    liftIO $ sendVerifyEmail ae email verKey verUrl
-    applyLayout "Confirmation e-mail sent" mempty [$hamlet|
+    let verUrl = render $ tm $ EmailVerifyR (fromPersistKey lid) verKey
+    sendVerifyEmail ae email verKey verUrl
+    defaultLayout $ setTitle "Confirmation e-mail sent" >> addBody [$hamlet|
 %p A confirmation e-mail has been sent to $email$.
 |]
 
 getEmailVerifyR :: YesodAuth master
-           => Integer -> String -> GHandler Auth master RepHtml
-getEmailVerifyR lid key = do
-    ae <- getAuthEmailSettings
-    realKey <- liftIO $ getVerifyKey ae lid
-    memail <- liftIO $ getEmail ae lid
+           => Int64 -> String -> GHandler Auth master RepHtml
+getEmailVerifyR lid' key = do
+    let lid = toPersistKey lid'
+    ae <- getEmailSettings
+    realKey <- getVerifyKey ae lid
+    memail <- getEmail ae lid
     case (realKey == Just key, memail) of
         (True, Just email) -> do
-            liftIO $ verifyAccount ae lid
-            setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)
-                      Nothing) []
-            toMaster <- getRouteToMaster
-            redirect RedirectTemporary $ toMaster EmailPasswordR
-        _ -> applyLayout "Invalid verification key" mempty [$hamlet|
+            muid <- verifyAccount ae lid
+            case muid of
+                Nothing -> return ()
+                Just uid -> do
+                    setCreds (Creds email AuthEmail (Just email) Nothing (Just uid)
+                              Nothing) []
+                    toMaster <- getRouteToMaster
+                    redirect RedirectTemporary $ toMaster EmailPasswordR
+        _ -> return ()
+    defaultLayout $ do
+        setTitle "Invalid verification key"
+        addBody [$hamlet|
 %p I'm sorry, but that was an invalid verification key.
 |]
 
-getEmailLoginR :: Yesod master => GHandler Auth master RepHtml
-getEmailLoginR = do
-    _ae <- getAuthEmailSettings
-    toMaster <- getRouteToMaster
-    msg <- getMessage
-    applyLayout "Login" mempty [$hamlet|
-$maybe msg ms
-    %p.message $ms$
-%p Please log in to your account.
-%p
-    %a!href=@toMaster.EmailRegisterR@ I don't have an account
-%form!method=post!action=@toMaster.EmailLoginR@
-    %table
-        %tr
-            %th E-mail
-            %td
-                %input!type=email!name=email
-        %tr
-            %th Password
-            %td
-                %input!type=password!name=password
-        %tr
-            %td!colspan=2
-                %input!type=submit!value=Login
-|]
-
 postEmailLoginR :: YesodAuth master => GHandler Auth master ()
 postEmailLoginR = do
-    ae <- getAuthEmailSettings
+    ae <- getEmailSettings
     (email, pass) <- runFormPost' $ (,)
         <$> emailInput "email"
         <*> stringInput "password"
     y <- getYesod
-    mecreds <- liftIO $ getEmailCreds ae email
-    let mlid =
-            case mecreds of
-                Just (EmailCreds lid (Just realpass) True _) ->
-                    if isValidPass pass realpass then Just lid else Nothing
-                _ -> Nothing
-    case mlid of
-        Just lid -> do
-            setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)
+    mecreds <- getEmailCreds ae email
+    maid <-
+        case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of
+            (Just aid, Just True) -> do
+                mrealpass <- getPassword ae aid
+                case mrealpass of
+                    Nothing -> return Nothing
+                    Just realpass -> return $
+                        if isValidPass pass realpass
+                            then Just aid
+                            else Nothing
+            _ -> return Nothing
+    case maid of
+        Just aid -> do
+            setCreds (Creds email AuthEmail (Just email) Nothing (Just aid)
                       Nothing) []
             redirectUltDest RedirectTemporary $ defaultDest y
         Nothing -> do
             setMessage $ string "Invalid email/password combination"
             toMaster <- getRouteToMaster
-            redirect RedirectTemporary $ toMaster EmailLoginR
+            redirect RedirectTemporary $ toMaster LoginR
 
-getEmailPasswordR :: Yesod master => GHandler Auth master RepHtml
+getEmailPasswordR :: YesodAuth master => GHandler Auth master RepHtml
 getEmailPasswordR = do
-    _ae <- getAuthEmailSettings
+    _ae <- getEmailSettings
     toMaster <- getRouteToMaster
-    mcreds <- maybeCreds
-    case mcreds of
-        Just (Creds _ AuthEmail _ _ (Just _) _) -> return ()
-        _ -> do
+    maid <- maybeAuthId
+    case maid of
+        Just _ -> return ()
+        Nothing -> do
             setMessage $ string "You must be logged in to set a password"
             redirect RedirectTemporary $ toMaster EmailLoginR
-    msg <- getMessage
-    applyLayout "Set password" mempty [$hamlet|
-$maybe msg ms
-    %p.message $ms$
+    defaultLayout $ do
+        setTitle "Set password"
+        addBody [$hamlet|
 %h3 Set a new password
 %form!method=post!action=@toMaster.EmailPasswordR@
     %table
@@ -419,7 +453,7 @@
 
 postEmailPasswordR :: YesodAuth master => GHandler Auth master ()
 postEmailPasswordR = do
-    ae <- getAuthEmailSettings
+    ae <- getEmailSettings
     (new, confirm) <- runFormPost' $ (,)
         <$> stringInput "new"
         <*> stringInput "confirm"
@@ -427,16 +461,17 @@
     when (new /= confirm) $ do
         setMessage $ string "Passwords did not match, please try again"
         redirect RedirectTemporary $ toMaster EmailPasswordR
-    mcreds <- maybeCreds
-    lid <- case mcreds of
-            Just (Creds _ AuthEmail _ _ (Just lid) _) -> return lid
-            _ -> do
+    maid <- maybeAuthId
+    aid <- case maid of
+            Nothing -> do
                 setMessage $ string "You must be logged in to set a password"
                 redirect RedirectTemporary $ toMaster EmailLoginR
+            Just aid -> return aid
     salted <- liftIO $ saltPass new
-    liftIO $ setPassword ae lid salted
+    setPassword ae aid salted
     setMessage $ string "Password updated"
-    redirect RedirectTemporary $ toMaster EmailLoginR
+    y <- getYesod
+    redirect RedirectTemporary $ defaultDest y
 
 saltLength :: Int
 saltLength = 5
@@ -457,45 +492,13 @@
 saltPass' :: String -> String -> String
 saltPass' salt pass = salt ++ show (md5 $ fromString $ salt ++ pass)
 
--- | A simplistic set of email settings, useful only for testing purposes. In
--- particular, it doesn't actually send emails, but instead prints verification
--- URLs to stderr.
-inMemoryEmailSettings :: IO AuthEmailSettings
-inMemoryEmailSettings = do
-    mm <- newMVar []
-    return AuthEmailSettings
-        { addUnverified = \email verkey -> modifyMVar mm $ \m -> do
-            let helper (_, EmailCreds x _ _ _) = x
-            let newId = 1 + maximum (0 : map helper m)
-            let ec = EmailCreds newId Nothing False verkey
-            return ((email, ec) : m, newId)
-        , sendVerifyEmail = \_email _verkey verurl ->
-            hPutStrLn stderr $ "Please go to: " ++ verurl
-        , getVerifyKey = \eid -> withMVar mm $ \m -> return $
-            lookup eid $ map (\(_, EmailCreds eid' _ _ vk) -> (eid', vk)) m
-        , verifyAccount = \eid -> modifyMVar_ mm $ return . map (vago eid)
-        , setPassword = \eid pass -> modifyMVar_ mm $ return . map (spgo eid pass)
-        , getEmailCreds = \email -> withMVar mm $ return . lookup email
-        , getEmail = \eid -> withMVar mm $ \m -> return $
-            case filter (\(_, EmailCreds eid' _ _ _) -> eid == eid') m of
-                ((email, _):_) -> Just email
-                _ -> Nothing
-        }
-  where
-    vago eid (email, EmailCreds eid' pass status key)
-        | eid == eid' = (email, EmailCreds eid pass True key)
-        | otherwise = (email, EmailCreds eid' pass status key)
-    spgo eid pass (email, EmailCreds eid' pass' status key)
-        | eid == eid' = (email, EmailCreds eid (Just pass) status key)
-        | otherwise = (email, EmailCreds eid' pass' status key)
-
 getFacebookR :: YesodAuth master => GHandler Auth master ()
 getFacebookR = do
     y <- getYesod
-    a <- authFacebook <$> getYesodSub
+    a <- facebookSettings <$> getYesod
     case a of
         Nothing -> notFound
-        Just (cid, secret, _) -> do
+        Just (FacebookSettings cid secret _) -> do
             render <- getUrlRender
             tm <- getRouteToMaster
             let fb = Facebook.Facebook cid secret $ render $ tm FacebookR
@@ -512,14 +515,64 @@
             setCreds c []
             redirectUltDest RedirectTemporary $ defaultDest y
 
-getStartFacebookR :: GHandler Auth master ()
-getStartFacebookR = do
-    y <- getYesodSub
-    case authFacebook y of
-        Nothing -> notFound
-        Just (cid, secret, perms) -> do
-            render <- getUrlRender
-            tm <- getRouteToMaster
-            let fb = Facebook.Facebook cid secret $ render $ tm FacebookR
-            let fburl = Facebook.getForwardUrl fb perms
-            redirectString RedirectTemporary fburl
+getFacebookUrl :: YesodAuth m
+               => (AuthRoute -> Route m) -> GHandler s m (Maybe String)
+getFacebookUrl tm = do
+    y <- getYesod
+    render <- getUrlRender
+    case facebookSettings y of
+        Nothing -> return Nothing
+        Just f -> do
+            let fb =
+                    Facebook.Facebook
+                        (fbAppId f)
+                        (fbSecret f)
+                        (render $ tm FacebookR)
+            return $ Just $ Facebook.getForwardUrl fb $ fbPerms f
+
+getLoginR :: YesodAuth master => GHandler Auth master RepHtml
+getLoginR = do
+    lookupGetParam "dest" >>= maybe (return ()) setUltDestString
+    tm <- getRouteToMaster
+    y <- getYesod
+    fb <- getFacebookUrl tm
+    defaultLayout $ do
+        setTitle "Login"
+        addStyle [$cassius|
+#openid
+    background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;
+    padding-left: 18px;
+|]
+        addBody [$hamlet|
+$maybe emailSettings.y _
+    %h3 Email
+    %form!method=post!action=@tm.EmailLoginR@
+        %table
+            %tr
+                %th E-mail
+                %td
+                    %input!type=email!name=email
+            %tr
+                %th Password
+                %td
+                    %input!type=password!name=password
+            %tr
+                %td!colspan=2
+                    %input!type=submit!value="Login via email"
+                    %a!href=@tm.EmailRegisterR@ I don't have an account
+$if openIdEnabled.y
+    %h3 OpenID
+    %form!action=@tm.OpenIdForwardR@
+        %label!for=openid OpenID: $
+        %input#openid!type=text!name=openid
+        %input!type=submit!value="Login via OpenID"
+$maybe fb f
+    %h3 Facebook
+    %p
+        %a!href=$f$ Login via Facebook
+$maybe rpxnowSettings.y r
+    %h3 OpenID
+    %p
+        %a!onclick="return false;"!href="https://$rpxnowApp.r$.rpxnow.com/openid/v2/signin?token_url=@tm.RpxnowR@"
+            Login via Rpxnow
+|]
diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs
--- a/Yesod/Helpers/Crud.hs
+++ b/Yesod/Helpers/Crud.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Yesod.Helpers.Crud
     ( Item (..)
     , Crud (..)
@@ -17,10 +18,10 @@
 import Yesod.Handler
 import Text.Hamlet
 import Yesod.Form
-import Data.Monoid (mempty)
+import Language.Haskell.TH.Syntax
 
 -- | An entity which can be displayed by the Crud subsite.
-class ToForm a => Item a where
+class Item a where
     -- | The title of an entity, to be displayed in the list of all entities.
     itemTitle :: a -> String
 
@@ -36,9 +37,10 @@
     }
 
 mkYesodSub "Crud master item"
-    [ ("master", [''Yesod])
-    , ("item", [''Item])
-    , ("Key item", [''SinglePiece])
+    [ ClassP ''Yesod [VarT $ mkName "master"]
+    , ClassP ''Item [VarT $ mkName "item"]
+    , ClassP ''SinglePiece [ConT ''Key `AppT` VarT (mkName "item")]
+    , ClassP ''ToForm [VarT $ mkName "item", VarT $ mkName "master"]
     ] [$parseRoutes|
 /               CrudListR        GET
 /add            CrudAddR         GET POST
@@ -51,7 +53,9 @@
 getCrudListR = do
     items <- getYesodSub >>= crudSelect
     toMaster <- getRouteToMaster
-    applyLayout "Items" mempty [$hamlet|
+    defaultLayout $ do
+        setTitle "Items"
+        addBody [$hamlet|
 %h1 Items
 %ul
     $forall items item
@@ -62,21 +66,24 @@
     %a!href=@toMaster.CrudAddR@ Add new item
 |]
 
-getCrudAddR :: (Yesod master, Item item, SinglePiece (Key item))
+getCrudAddR :: (Yesod master, Item item, SinglePiece (Key item),
+                ToForm item master)
             => GHandler (Crud master item) master RepHtml
 getCrudAddR = crudHelper
                 "Add new"
                 (Nothing :: Maybe (Key item, item))
                 False
 
-postCrudAddR :: (Yesod master, Item item, SinglePiece (Key item))
+postCrudAddR :: (Yesod master, Item item, SinglePiece (Key item),
+                 ToForm item master)
              => GHandler (Crud master item) master RepHtml
 postCrudAddR = crudHelper
                 "Add new"
                 (Nothing :: Maybe (Key item, item))
                 True
 
-getCrudEditR :: (Yesod master, Item item, SinglePiece (Key item))
+getCrudEditR :: (Yesod master, Item item, SinglePiece (Key item),
+                 ToForm item master)
              => String -> GHandler (Crud master item) master RepHtml
 getCrudEditR s = do
     itemId <- maybe notFound return $ itemReadId s
@@ -87,7 +94,8 @@
         (Just (itemId, item))
         False
 
-postCrudEditR :: (Yesod master, Item item, SinglePiece (Key item))
+postCrudEditR :: (Yesod master, Item item, SinglePiece (Key item),
+                  ToForm item master)
               => String -> GHandler (Crud master item) master RepHtml
 postCrudEditR s = do
     itemId <- maybe notFound return $ itemReadId s
@@ -105,7 +113,9 @@
     crud <- getYesodSub
     item <- crudGet crud itemId >>= maybe notFound return -- Just ensure it exists
     toMaster <- getRouteToMaster
-    applyLayout "Confirm delete" mempty [$hamlet|
+    defaultLayout $ do
+        setTitle "Confirm delete"
+        addBody [$hamlet|
 %form!method=post!action=@toMaster.CrudDeleteR.s@
     %h1 Really delete?
     %p Do you really want to delete $itemTitle.item$?
@@ -128,7 +138,7 @@
 itemReadId = either (const Nothing) Just . fromSinglePiece
 
 crudHelper
-    :: (Item a, Yesod master, SinglePiece (Key a))
+    :: (Item a, Yesod master, SinglePiece (Key a), ToForm a master)
     => String -> Maybe (Key a, a) -> Bool
     -> GHandler (Crud master a) master RepHtml
 crudHelper title me isPost = do
@@ -145,7 +155,7 @@
             redirect RedirectTemporary $ toMaster $ CrudEditR
                                        $ toSinglePiece eid
         _ -> return ()
-    applyLayoutW $ do
+    defaultLayout $ do
         wrapWidget form (wrapForm toMaster enctype)
         setTitle $ string title
   where
@@ -153,7 +163,7 @@
 %p
     %a!href=@toMaster.CrudListR@ Return to list
 %h1 $title$
-%form!method=post!enctype=$show.enctype$
+%form!method=post!enctype=$enctype$
     %table
         ^form^
         %tr
@@ -170,7 +180,7 @@
         YesodPersist a)
     => a -> Crud a i
 defaultCrud = const Crud
-    { crudSelect = runDB $ select [] []
+    { crudSelect = runDB $ selectList [] [] 0 0
     , crudReplace = \a -> runDB . replace a
     , crudInsert = runDB . insert
     , crudGet = runDB . get
diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -31,6 +31,8 @@
       -- * Lookup files in filesystem
     , fileLookupDir
     , staticFiles
+      -- * Hashing
+    , base64md5
 #if TEST
     , testSuite
 #endif
@@ -40,10 +42,17 @@
 import Control.Monad
 import Data.Maybe (fromMaybe)
 
-import Yesod
+import Yesod hiding (lift)
 import Data.List (intercalate)
 import Language.Haskell.TH.Syntax
 
+import qualified Data.ByteString.Lazy as L
+import Data.Digest.Pure.MD5
+import qualified Codec.Binary.Base64Url
+import qualified Data.ByteString as S
+import qualified Data.Serialize
+import Yesod.WebRoutes
+
 #if TEST
 import Test.Framework (testGroup, Test)
 import Test.Framework.Providers.HUnit
@@ -58,10 +67,21 @@
     , staticTypes :: [(String, ContentType)]
     }
 
-mkYesodSub "Static" [] [$parseRoutes|
-*Strings StaticRoute GET
-|]
+data StaticRoute = StaticRoute [String] [(String, String)]
+    deriving (Eq, Show, Read)
 
+type instance Route Static = StaticRoute
+
+instance YesodSubSite Static master where
+    getSubSite = Site
+        { handleSite = \_ (StaticRoute ps _) m ->
+                            case m of
+                                "GET" -> Just $ fmap chooseRep $ getStaticRoute ps
+                                _ -> Nothing
+        , formatPathSegments = \(StaticRoute x y) -> (x, y)
+        , parsePathSegments = \x -> Right $ StaticRoute x []
+        }
+
 -- | Lookup files in a specific directory.
 --
 -- If you are just using this in combination with the static subsite (you
@@ -132,10 +152,12 @@
         let name = mkName $ intercalate "_" $ map (map replace') f
         f' <- lift f
         let sr = ConE $ mkName "StaticRoute"
+        hash <- qRunIO $ fmap base64md5 $ L.readFile $ fp ++ '/' : intercalate "/" f
+        let qs = ListE [TupE [LitE $ StringL hash, ListE []]]
         return
             [ SigD name $ ConT ''Route `AppT` ConT ''Static
             , FunD name
-                [ Clause [] (NormalB $ sr `AppE` f') []
+                [ Clause [] (NormalB $ sr `AppE` f' `AppE` qs) []
                 ]
             ]
 
@@ -152,3 +174,14 @@
     x @?= [["foo"], ["bar", "baz"]]
 
 #endif
+
+-- | md5-hashes the given lazy bytestring and returns the hash as
+-- base64url-encoded string.
+--
+-- This function returns the first 8 characters of the hash.
+base64md5 :: L.ByteString -> String
+base64md5 = take 8
+          . Codec.Binary.Base64Url.encode
+          . S.unpack
+          . Data.Serialize.encode
+          . md5
diff --git a/Yesod/Internal.hs b/Yesod/Internal.hs
--- a/Yesod/Internal.hs
+++ b/Yesod/Internal.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -- | Normal users should never need access to these.
 module Yesod.Internal
     ( -- * Error responses
@@ -6,8 +8,23 @@
     , Header (..)
       -- * Cookie names
     , langKey
+      -- * Widgets
+    , Location (..)
+    , UniqueList (..)
+    , Script (..)
+    , Stylesheet (..)
+    , Title (..)
+    , Head (..)
+    , Body (..)
+    , locationToHamlet
+    , runUniqueList
+    , toUnique
     ) where
 
+import Text.Hamlet (Hamlet, hamlet, Html)
+import Data.Monoid (Monoid (..))
+import Data.List (nub)
+
 -- | Responses to indicate some form of an error occurred. These are different
 -- from 'SpecialResponse' in that they allow for custom error pages.
 data ErrorResponse =
@@ -28,3 +45,29 @@
 
 langKey :: String
 langKey = "_LANG"
+
+data Location url = Local url | Remote String
+    deriving (Show, Eq)
+locationToHamlet :: Location url -> Hamlet url
+locationToHamlet (Local url) = [$hamlet|@url@|]
+locationToHamlet (Remote s) = [$hamlet|$s$|]
+
+newtype UniqueList x = UniqueList ([x] -> [x])
+instance Monoid (UniqueList x) where
+    mempty = UniqueList id
+    UniqueList x `mappend` UniqueList y = UniqueList $ x . y
+runUniqueList :: Eq x => UniqueList x -> [x]
+runUniqueList (UniqueList x) = nub $ x []
+toUnique :: x -> UniqueList x
+toUnique = UniqueList . (:)
+
+newtype Script url = Script { unScript :: Location url }
+    deriving (Show, Eq)
+newtype Stylesheet url = Stylesheet { unStylesheet :: Location url }
+    deriving (Show, Eq)
+newtype Title = Title { unTitle :: Html }
+
+newtype Head url = Head (Hamlet url)
+    deriving Monoid
+newtype Body url = Body (Hamlet url)
+    deriving Monoid
diff --git a/Yesod/Json.hs b/Yesod/Json.hs
--- a/Yesod/Json.hs
+++ b/Yesod/Json.hs
@@ -1,6 +1,7 @@
--- | Efficient generation of JSON documents, with HTML-entity encoding handled via types.
+-- | Efficient generation of JSON documents.
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Yesod.Json
     ( -- * Monad
       Json
@@ -18,12 +19,12 @@
     where
 
 import qualified Data.ByteString.Char8 as S
-import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Char (isControl)
-import Yesod.Hamlet
 import Yesod.Handler
 import Numeric (showHex)
 import Data.Monoid (Monoid (..))
+import Text.Blaze.Builder.Core
+import Text.Blaze.Builder.Utf8 (writeChar)
 
 #if TEST
 import Test.Framework (testGroup, Test)
@@ -35,21 +36,20 @@
 import Yesod.Content
 #endif
 
--- | A monad for generating Json output. In truth, it is just a newtype wrapper
--- around 'Html'; we thereby get the benefits of BlazeHtml (type safety and
--- speed) without accidently mixing non-JSON content.
+-- | A monad for generating Json output. It wraps the Builder monoid from the
+-- blaze-builder package.
 --
 -- This is an opaque type to avoid any possible insertion of non-JSON content.
 -- Due to the limited nature of the JSON format, you can create any valid JSON
 -- document you wish using only 'jsonScalar', 'jsonList' and 'jsonMap'.
-newtype Json = Json { unJson :: Html () }
+newtype Json = Json { unJson :: Builder }
     deriving Monoid
 
 -- | Extract the final result from the given 'Json' value.
 --
 -- See also: applyLayoutJson in "Yesod.Yesod".
 jsonToContent :: Json -> GHandler sub master Content
-jsonToContent = return . toContent . renderHtml . unJson
+jsonToContent = return . toContent . toLazyByteString . unJson
 
 -- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
 jsonToRepJson :: Json -> GHandler sub master RepJson
@@ -57,61 +57,58 @@
 
 -- | Outputs a single scalar. This function essentially:
 --
--- * Performs HTML entity escaping as necesary.
---
 -- * Performs JSON encoding.
 --
 -- * Wraps the resulting string in quotes.
-jsonScalar :: Html () -> Json
+jsonScalar :: String -> Json
 jsonScalar s = Json $ mconcat
-    [ preEscapedString "\""
-    , unsafeByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s
-    , preEscapedString "\""
+    [ fromByteString "\""
+    , writeList writeJsonChar s
+    , fromByteString "\""
     ]
   where
-    encodeJson = L.concatMap (L.pack . encodeJsonChar)
-
-    encodeJsonChar '\b' = "\\b"
-    encodeJsonChar '\f' = "\\f"
-    encodeJsonChar '\n' = "\\n"
-    encodeJsonChar '\r' = "\\r"
-    encodeJsonChar '\t' = "\\t"
-    encodeJsonChar '"' = "\\\""
-    encodeJsonChar '\\' = "\\\\"
-    encodeJsonChar c
-        | not $ isControl c = [c]
-        | c < '\x10'   = '\\' : 'u' : '0' : '0' : '0' : hexxs
-        | c < '\x100'  = '\\' : 'u' : '0' : '0' : hexxs
-        | c < '\x1000' = '\\' : 'u' : '0' : hexxs
+    writeJsonChar '\b' = writeByteString "\\b"
+    writeJsonChar '\f' = writeByteString "\\f"
+    writeJsonChar '\n' = writeByteString "\\n"
+    writeJsonChar '\r' = writeByteString "\\r"
+    writeJsonChar '\t' = writeByteString "\\t"
+    writeJsonChar '"' = writeByteString "\\\""
+    writeJsonChar '\\' = writeByteString "\\\\"
+    writeJsonChar c
+        | not $ isControl c = writeChar c
+        | c < '\x10'   = writeString $ '\\' : 'u' : '0' : '0' : '0' : hexxs
+        | c < '\x100'  = writeString $ '\\' : 'u' : '0' : '0' : hexxs
+        | c < '\x1000' = writeString $ '\\' : 'u' : '0' : hexxs
         where hexxs = showHex (fromEnum c) ""
-    encodeJsonChar c = [c]
+    writeJsonChar c = writeChar c
+    writeString = writeByteString . S.pack
 
 -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
 jsonList :: [Json] -> Json
-jsonList [] = Json $ preEscapedString "[]"
+jsonList [] = Json $ fromByteString "[]"
 jsonList (x:xs) = mconcat
-    [ Json $ preEscapedString "["
+    [ Json $ fromByteString "["
     , x
     , mconcat $ map go xs
-    , Json $ preEscapedString "]"
+    , Json $ fromByteString "]"
     ]
   where
-    go = mappend (Json $ preEscapedString ",")
+    go = mappend (Json $ fromByteString ",")
 
 -- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}.
 jsonMap :: [(String, Json)] -> Json
-jsonMap [] = Json $ preEscapedString "{}"
+jsonMap [] = Json $ fromByteString "{}"
 jsonMap (x:xs) = mconcat
-    [ Json $ preEscapedString "{"
+    [ Json $ fromByteString "{"
     , go x
     , mconcat $ map go' xs
-    , Json $ preEscapedString "}"
+    , Json $ fromByteString "}"
     ]
   where
-    go' y = mappend (Json $ preEscapedString ",") $ go y
+    go' y = mappend (Json $ fromByteString ",") $ go y
     go (k, v) = mconcat
-        [ jsonScalar $ string k
-        , Json $ preEscapedString ":"
+        [ jsonScalar k
+        , Json $ fromByteString ":"
         , v
         ]
 
@@ -119,7 +116,7 @@
 -- this is the only function in this module that allows you to create broken
 -- JSON documents.
 jsonRaw :: S.ByteString -> Json
-jsonRaw bs = Json $ unsafeByteString bs
+jsonRaw = Json . fromByteString
 
 #if TEST
 
@@ -133,10 +130,10 @@
     let j = do
         jsonMap
             [ ("foo" , jsonList
-                [ jsonScalar $ preEscapedString "bar"
-                , jsonScalar $ preEscapedString "baz"
+                [ jsonScalar "bar"
+                , jsonScalar "baz"
                 ])
             ]
-    "{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (renderHtml $ unJson j)
+    "{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (toLazyByteString $ unJson j)
 
 #endif
diff --git a/Yesod/Mail.hs b/Yesod/Mail.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Mail.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Yesod.Mail
+    ( Boundary (..)
+    , Mail (..)
+    , Part (..)
+    , Encoding (..)
+    , renderMail
+    , renderMail'
+    , sendmail
+    , Disposition (..)
+    , renderSendMail
+    , randomString
+    ) where
+
+import qualified Data.ByteString.Lazy as L
+import Text.Blaze.Builder.Utf8
+import Text.Blaze.Builder.Core
+import Data.Monoid
+import System.Random
+import Control.Arrow
+import System.Process
+import System.IO
+import System.Exit
+import Codec.Binary.Base64 (encode)
+import Control.Monad ((<=<))
+
+randomString :: RandomGen d => Int -> d -> (String, d)
+randomString len =
+    first (map toChar) . sequence' (replicate len (randomR (0, 61)))
+  where
+    sequence' [] g = ([], g)
+    sequence' (f:fs) g =
+        let (f', g') = f g
+            (fs', g'') = sequence' fs g'
+         in (f' : fs', g'')
+    toChar i
+        | i < 26 = toEnum $ i + fromEnum 'A'
+        | i < 52 = toEnum $ i + fromEnum 'a' - 26
+        | otherwise = toEnum $ i + fromEnum '0' - 52
+
+newtype Boundary = Boundary { unBoundary :: String }
+instance Random Boundary where
+    randomR = const random
+    random = first Boundary . randomString 10
+
+data Mail = Mail
+    { mailHeaders :: [(String, String)]
+    , mailPlain :: String
+    , mailParts :: [Part]
+    }
+
+data Encoding = None | Base64
+
+data Part = Part
+    { partType :: String -- ^ content type
+    , partEncoding :: Encoding
+    , partDisposition :: Disposition
+    , partContent :: L.ByteString
+    }
+
+data Disposition = Inline | Attachment String
+
+renderMail :: Boundary -> Mail -> L.ByteString
+renderMail (Boundary b) (Mail headers plain parts) = toLazyByteString $ mconcat
+    [ mconcat $ map showHeader headers
+    , mconcat $ map showHeader
+        [ ("MIME-Version", "1.0")
+        , ("Content-Type", "multipart/mixed; boundary=\""
+            ++ b ++ "\"")
+        ]
+    , fromByteString "\n"
+    , fromString plain
+    , mconcat $ map showPart parts
+    , fromByteString "\n--"
+    , fromString b
+    , fromByteString "--"
+    ]
+  where
+    showHeader (k, v) = mconcat
+        [ fromString k
+        , fromByteString ": "
+        , fromString v
+        , fromByteString "\n"
+        ]
+    showPart (Part contentType encoding disposition content) = mconcat
+        [ fromByteString "\n--"
+        , fromString b
+        , fromByteString "\n"
+        , showHeader ("Content-Type", contentType)
+        , case encoding of
+            None -> mempty
+            Base64 -> showHeader ("Content-Transfer-Encoding", "base64")
+        , case disposition of
+            Inline -> mempty
+            Attachment filename ->
+                showHeader ("Content-Disposition", "attachment; filename=" ++ filename)
+        , fromByteString "\n"
+        , case encoding of
+            None -> writeList writeByteString $ L.toChunks content
+            Base64 -> writeList writeByte $ map (toEnum . fromEnum) $ encode $ L.unpack content
+        ]
+
+renderMail' :: Mail -> IO L.ByteString
+renderMail' m = do
+    b <- randomIO
+    return $ renderMail b m
+
+sendmail :: L.ByteString -> IO ()
+sendmail lbs = do
+    (Just hin, _, _, phandle) <- createProcess $ (proc
+        "/usr/sbin/sendmail" ["-t"]) { std_in = CreatePipe }
+    L.hPut hin lbs
+    hClose hin
+    exitCode <- waitForProcess phandle
+    case exitCode of
+        ExitSuccess -> return ()
+        _ -> error $ "sendmail exited with error code " ++ show exitCode
+
+renderSendMail :: Mail -> IO ()
+renderSendMail = sendmail <=< renderMail'
diff --git a/Yesod/WebRoutes.hs b/Yesod/WebRoutes.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/WebRoutes.hs
@@ -0,0 +1,88 @@
+-- | This module should be removed when web-routes incorporates necessary support.
+module Yesod.WebRoutes
+    ( encodePathInfo
+    , Site (..)
+    ) where
+
+import Codec.Binary.UTF8.String (encodeString)
+import Data.List (intercalate)
+import Network.URI
+
+encodePathInfo :: [String] -> [(String, String)] -> String
+encodePathInfo pieces qs = 
+  let x = map encodeString  `o` -- utf-8 encode the data characters in path components (we have not added any delimiters yet)
+          map (escapeURIString (\c -> isUnreserved c || c `elem` ":@&=+$,"))   `o` -- percent encode the characters
+          map (\str -> case str of "." -> "%2E" ; ".." -> "%2E%2E" ; _ -> str) `o` -- encode . and ..
+          intercalate "/"  -- add in the delimiters
+      y = showParams qs
+   in x pieces ++ y
+    where
+      -- reverse composition 
+      o :: (a -> b) -> (b -> c) -> a -> c
+      o = flip (.)
+
+{-|
+
+A site groups together the three functions necesary to make an application:
+
+* A function to convert from the URL type to path segments.
+
+* A function to convert from path segments to the URL, if possible.
+
+* A function to return the application for a given URL.
+
+There are two type parameters for Site: the first is the URL datatype, the
+second is the application datatype. The application datatype will depend upon
+your server backend.
+-}
+data Site url a
+    = Site {
+           {-|
+               Return the appropriate application for a given URL.
+
+               The first argument is a function which will give an appropriate
+               URL (as a String) for a URL datatype. This is usually
+               constructed by a combination of 'formatPathSegments' and the
+               prepending of an absolute application root.
+
+               Well behaving applications should use this function to
+               generating all internal URLs.
+           -}
+             handleSite         :: (url -> [(String, String)] -> String) -> url -> a
+           -- | This function must be the inverse of 'parsePathSegments'.
+           , formatPathSegments :: url -> ([String], [(String, String)])
+           -- | This function must be the inverse of 'formatPathSegments'.
+           , parsePathSegments  :: [String] -> Either String url
+           }
+
+showParams :: [(String, String)] -> String
+showParams [] = ""
+showParams z =
+    '?' : intercalate "&" (map go z)
+  where
+    go (x, "") = go' x
+    go (x, y) = go' x ++ '=' : go' y
+    go' = concatMap encodeUrlChar
+
+-- | Taken straight from web-encodings; reimplemented here to avoid extra
+-- dependencies.
+encodeUrlChar :: Char -> String
+encodeUrlChar c
+    -- List of unreserved characters per RFC 3986
+    -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding
+    | 'A' <= c && c <= 'Z' = [c]
+    | 'a' <= c && c <= 'z' = [c]
+    | '0' <= c && c <= '9' = [c]
+encodeUrlChar c@'-' = [c]
+encodeUrlChar c@'_' = [c]
+encodeUrlChar c@'.' = [c]
+encodeUrlChar c@'~' = [c]
+encodeUrlChar ' ' = "+"
+encodeUrlChar y =
+    let (a, c) = fromEnum y `divMod` 16
+        b = a `mod` 16
+        showHex' x
+            | x < 10 = toEnum $ x + (fromEnum '0')
+            | x < 16 = toEnum $ x - 10 + (fromEnum 'A')
+            | otherwise = error $ "Invalid argument to showHex: " ++ show x
+     in ['%', showHex' b, showHex' c]
diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
--- a/Yesod/Widget.hs
+++ b/Yesod/Widget.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -7,73 +6,39 @@
 -- generator, allowing you to create truly modular HTML components.
 module Yesod.Widget
     ( -- * Datatype
-      GWidget
+      GWidget (..)
     , Widget
     , liftHandler
-      -- * Unwrapping
-    , widgetToPageContent
-    , applyLayoutW
       -- * Creating
     , newIdent
     , setTitle
     , addStyle
     , addStylesheet
     , addStylesheetRemote
+    , addStylesheetEither
     , addScript
     , addScriptRemote
+    , addScriptEither
     , addHead
     , addBody
-    , addJavaScript
+    , addJavascript
       -- * Manipulating
     , wrapWidget
     , extractBody
-      -- * Default library URLs
-    , urlJqueryJs
-    , urlJqueryUiJs
-    , urlJqueryUiCss
     ) where
 
-import Data.List (nub)
 import Data.Monoid
 import Control.Monad.Trans.Writer
 import Control.Monad.Trans.State
-import Yesod.Hamlet (Hamlet, hamlet, PageContent (..), Html)
+import Text.Hamlet
+import Text.Cassius
+import Text.Julius
 import Yesod.Handler (Route, GHandler)
-import Yesod.Yesod (Yesod, defaultLayout)
-import Yesod.Content (RepHtml (..))
 import Control.Applicative (Applicative)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Trans.Class (lift)
 import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO)
-
-data Location url = Local url | Remote String
-    deriving (Show, Eq)
-locationToHamlet :: Location url -> Hamlet url
-locationToHamlet (Local url) = [$hamlet|@url@|]
-locationToHamlet (Remote s) = [$hamlet|$s$|]
-
-newtype UniqueList x = UniqueList ([x] -> [x])
-instance Monoid (UniqueList x) where
-    mempty = UniqueList id
-    UniqueList x `mappend` UniqueList y = UniqueList $ x . y
-runUniqueList :: Eq x => UniqueList x -> [x]
-runUniqueList (UniqueList x) = nub $ x []
-toUnique :: x -> UniqueList x
-toUnique = UniqueList . (:)
-
-newtype Script url = Script { unScript :: Location url }
-    deriving (Show, Eq)
-newtype Stylesheet url = Stylesheet { unStylesheet :: Location url }
-    deriving (Show, Eq)
-newtype Title = Title { unTitle :: Html () }
-newtype Style url = Style (Maybe (Hamlet url))
-    deriving Monoid
-newtype Head url = Head (Hamlet url)
-    deriving Monoid
-newtype Body url = Body (Hamlet url)
-    deriving Monoid
-newtype JavaScript url = JavaScript (Maybe (Hamlet url))
-    deriving Monoid
+import Yesod.Internal
 
 -- | A generic widget, allowing specification of both the subsite and master
 -- site datatypes. This is basically a large 'WriterT' stack keeping track of
@@ -83,8 +48,8 @@
     WriterT (Last Title) (
     WriterT (UniqueList (Script (Route master))) (
     WriterT (UniqueList (Stylesheet (Route master))) (
-    WriterT (Style (Route master)) (
-    WriterT (JavaScript (Route master)) (
+    WriterT (Maybe (Cassius (Route master))) (
+    WriterT (Maybe (Julius (Route master))) (
     WriterT (Head (Route master)) (
     StateT Int (
     GHandler sub master
@@ -103,7 +68,7 @@
 
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.
-setTitle :: Html () -> GWidget sub master ()
+setTitle :: Html -> GWidget sub master ()
 setTitle = GWidget . lift . tell . Last . Just . Title
 
 -- | Add some raw HTML to the head tag.
@@ -123,8 +88,8 @@
     return $ "w" ++ show i'
 
 -- | Add some raw CSS to the style tag.
-addStyle :: Hamlet (Route master) -> GWidget sub master ()
-addStyle = GWidget . lift . lift . lift . lift . tell . Style . Just
+addStyle :: Cassius (Route master) -> GWidget sub master ()
+addStyle = GWidget . lift . lift . lift . lift . tell . Just
 
 -- | Link to the specified local stylesheet.
 addStylesheet :: Route master -> GWidget sub master ()
@@ -135,6 +100,12 @@
 addStylesheetRemote =
     GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Remote
 
+addStylesheetEither :: Either (Route master) String -> GWidget sub master ()
+addStylesheetEither = either addStylesheet addStylesheetRemote
+
+addScriptEither :: Either (Route master) String -> GWidget sub master ()
+addScriptEither = either addScript addScriptRemote
+
 -- | Link to the specified local script.
 addScript :: Route master -> GWidget sub master ()
 addScript = GWidget . lift . lift . tell . toUnique . Script . Local
@@ -145,47 +116,8 @@
     GWidget . lift . lift . tell . toUnique . Script . Remote
 
 -- | Include raw Javascript in the page's script tag.
-addJavaScript :: Hamlet (Route master) -> GWidget sub master ()
-addJavaScript = GWidget . lift . lift . lift . lift . lift. tell
-              . JavaScript . Just
-
--- | Apply the default layout to the given widget.
-applyLayoutW :: (Eq (Route m), Yesod m)
-             => GWidget sub m () -> GHandler sub m RepHtml
-applyLayoutW w = widgetToPageContent w >>= fmap RepHtml . defaultLayout
-
--- | Convert a widget to a 'PageContent'.
-widgetToPageContent :: Eq (Route master)
-                    => GWidget sub master ()
-                    -> GHandler sub master (PageContent (Route master))
-widgetToPageContent (GWidget w) = do
-    w' <- flip evalStateT 0
-        $ runWriterT $ runWriterT $ runWriterT $ runWriterT
-        $ runWriterT $ runWriterT $ runWriterT w
-    let ((((((((),
-         Body body),
-         Last mTitle),
-         scripts'),
-         stylesheets'),
-         Style style),
-         JavaScript jscript),
-         Head head') = w'
-    let title = maybe mempty unTitle mTitle
-    let scripts = map (locationToHamlet . unScript) $ runUniqueList scripts'
-    let stylesheets = map (locationToHamlet . unStylesheet)
-                    $ runUniqueList stylesheets'
-    let head'' = [$hamlet|
-$forall scripts s
-    %script!src=^s^
-$forall stylesheets s
-    %link!rel=stylesheet!href=^s^
-$maybe style s
-    %style ^s^
-$maybe jscript j
-    %script ^j^
-^head'^
-|]
-    return $ PageContent title head'' body
+addJavascript :: Julius (Route master) -> GWidget sub master ()
+addJavascript = GWidget . lift . lift . lift . lift . lift. tell . Just
 
 -- | Modify the given 'GWidget' by wrapping the body tag HTML code with the
 -- given function. You might also consider using 'extractBody'.
@@ -204,18 +136,3 @@
     GWidget $ mapWriterT (fmap go) w
   where
     go ((), Body h) = (h, Body mempty)
-
--- | The Google-hosted jQuery 1.4.2 file.
-urlJqueryJs :: String
-urlJqueryJs =
-    "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
-
--- | The Google-hosted jQuery UI 1.8.1 javascript file.
-urlJqueryUiJs :: String
-urlJqueryUiJs =
-    "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
-
--- | The Google-hosted jQuery UI 1.8.1 CSS file with cupertino theme.
-urlJqueryUiCss :: String
-urlJqueryUiCss =
-    "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
 -- | The basic typeclass for a Yesod application.
 module Yesod.Yesod
     ( -- * Type classes
@@ -16,36 +18,61 @@
       -- ** Breadcrumbs
     , YesodBreadcrumbs (..)
     , breadcrumbs
-      -- * Convenience functions
-    , applyLayout
-    , applyLayoutJson
+      -- * Utitlities
     , maybeAuthorized
+    , widgetToPageContent
+    , defaultLayoutJson
       -- * Defaults
     , defaultErrorHandler
       -- * Data types
     , AuthResult (..)
+#if TEST
+    , testSuite
+#endif
     ) where
 
+#if TEST
+import Yesod.Content hiding (testSuite)
+import Yesod.Json hiding (testSuite)
+#else
 import Yesod.Content
+import Yesod.Json
+#endif
+
+import Yesod.Widget
 import Yesod.Request
 import Yesod.Hamlet
 import Yesod.Handler
 import qualified Network.Wai as W
-import Yesod.Json
 import Yesod.Internal
 import Web.ClientSession (getKey, defaultKeyFile)
 import qualified Web.ClientSession as CS
-import Data.Monoid (mempty)
-import Data.ByteString.UTF8 (toString)
+import qualified Data.ByteString.UTF8 as BSU
 import Database.Persist
-import Web.Routes.Site (Site)
 import Control.Monad.Trans.Class (MonadTrans (..))
 import Control.Monad.Attempt (Failure)
+import qualified Data.ByteString as S
+import qualified Network.Wai.Middleware.CleanPath
+import qualified Data.ByteString.Lazy as L
+import Yesod.WebRoutes
+import Data.Monoid
+import Control.Monad.Trans.Writer
+import Control.Monad.Trans.State hiding (get)
+import Text.Hamlet
+import Text.Cassius
+import Text.Julius
 
+#if TEST
+import Test.Framework (testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit hiding (Test)
+#endif
+
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
 class Eq (Route y) => YesodSite y where
-    getSite :: Site (Route y) (Method -> Maybe (Handler y ChooseRep))
+    getSite :: Site (Route y) (Method -> Maybe (GHandler y y ChooseRep))
 type Method = String
 
 -- | Same as 'YesodSite', but for subsites. Once again, users should not need
@@ -82,8 +109,10 @@
     errorHandler = defaultErrorHandler
 
     -- | Applies some form of layout to the contents of a page.
-    defaultLayout :: PageContent (Route a) -> GHandler sub a Content
-    defaultLayout p = hamletToContent [$hamlet|
+    defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
+    defaultLayout w = do
+        p <- widgetToPageContent w
+        hamletToRepHtml [$hamlet|
 !!!
 %html
     %head
@@ -108,9 +137,24 @@
     -- Return 'Nothing' is the request is authorized, 'Just' a message if
     -- unauthorized. If authentication is required, you should use a redirect;
     -- the Auth helper provides this functionality automatically.
-    isAuthorized :: Route a -> GHandler s a AuthResult
-    isAuthorized _ = return Authorized
+    isAuthorized :: Route a
+                 -> Bool -- ^ is this a write request?
+                 -> GHandler s a AuthResult
+    isAuthorized _ _ = return Authorized
 
+    -- | Determines whether the current request is a write request. By default,
+    -- this assumes you are following RESTful principles, and determines this
+    -- from request method. In particular, all except the following request
+    -- methods are considered write: GET HEAD OPTIONS TRACE.
+    --
+    -- This function is used to determine if a request is authorized; see
+    -- 'isAuthorized'.
+    isWriteRequest :: Route a -> GHandler s a Bool
+    isWriteRequest _ = do
+        wai <- waiRequest
+        return $ not $ W.requestMethod wai `elem`
+            ["GET", "HEAD", "OPTIONS", "TRACE"]
+
     -- | The default route for authentication.
     --
     -- Used in particular by 'isAuthorized', but library users can do whatever
@@ -118,6 +162,48 @@
     authRoute :: a -> Maybe (Route a)
     authRoute _ = Nothing
 
+    -- | A function used to split a raw PATH_INFO value into path pieces. It
+    -- returns a 'Left' value when you should redirect to the given path, and a
+    -- 'Right' value on successful parse.
+    --
+    -- By default, it splits paths on slashes, and ensures the following are true:
+    --
+    -- * No double slashes
+    --
+    -- * If the last path segment has a period, there is no trailing slash.
+    --
+    -- * Otherwise, ensures there /is/ a trailing slash.
+    splitPath :: a -> S.ByteString -> Either S.ByteString [String]
+    splitPath _ = Network.Wai.Middleware.CleanPath.splitPath
+
+    -- | Join the pieces of a path together into an absolute URL. This should
+    -- be the inverse of 'splitPath'.
+    joinPath :: a -> String -> [String] -> [(String, String)] -> String
+    joinPath _ ar pieces qs =
+        ar ++ '/' : encodePathInfo (fixSegs pieces) qs
+      where
+        fixSegs [] = []
+        fixSegs [x]
+            | any (== '.') x = [x]
+            | otherwise = [x, ""] -- append trailing slash
+        fixSegs (x:xs) = x : fixSegs xs
+
+    -- | This function is used to store some static content to be served as an
+    -- external file. The most common case of this is stashing CSS and
+    -- JavaScript content in an external file; the "Yesod.Widget" module uses
+    -- this feature.
+    --
+    -- The return value is 'Nothing' if no storing was performed; this is the
+    -- default implementation. A 'Just' 'Left' gives the absolute URL of the
+    -- file, whereas a 'Just' 'Right' gives the type-safe URL. The former is
+    -- necessary when you are serving the content outside the context of a
+    -- Yesod application, such as via memcached.
+    addStaticContent :: String -- ^ filename extension
+                     -> String -- ^ mime-type
+                     -> L.ByteString -- ^ content
+                     -> GHandler sub a (Maybe (Either String (Route a, [(String, String)])))
+    addStaticContent _ _ _ = return Nothing
+
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
     deriving (Eq, Show, Read)
 
@@ -148,49 +234,33 @@
         (title, next) <- breadcrumb this
         go ((this, title) : back) next
 
--- | Apply the default layout ('defaultLayout') to the given title and body.
-applyLayout :: Yesod master
-            => String -- ^ title
-            -> Hamlet (Route master) -- ^ head
-            -> Hamlet (Route master) -- ^ body
-            -> GHandler sub master RepHtml
-applyLayout t h b =
-    RepHtml `fmap` defaultLayout PageContent
-                { pageTitle = string t
-                , pageHead = h
-                , pageBody = b
-                }
-
 -- | Provide both an HTML and JSON representation for a piece of data, using
 -- the default layout for the HTML output ('defaultLayout').
-applyLayoutJson :: Yesod master
-                => String -- ^ title
-                -> Hamlet (Route master) -- ^ head
-                -> Hamlet (Route master) -- ^ body
-                -> Json
-                -> GHandler sub master RepHtmlJson
-applyLayoutJson t h html json = do
-    html' <- defaultLayout PageContent
-                { pageTitle = string t
-                , pageHead = h
-                , pageBody = html
-                }
+defaultLayoutJson :: Yesod master
+                  => GWidget sub master ()
+                  -> Json
+                  -> GHandler sub master RepHtmlJson
+defaultLayoutJson w json = do
+    RepHtml html' <- defaultLayout w
     json' <- jsonToContent json
     return $ RepHtmlJson html' json'
 
 applyLayout' :: Yesod master
-             => String -- ^ title
+             => Html -- ^ title
              -> Hamlet (Route master) -- ^ body
              -> GHandler sub master ChooseRep
-applyLayout' s = fmap chooseRep . applyLayout s mempty
+applyLayout' title body = fmap chooseRep $ defaultLayout $ do
+    setTitle title
+    addBody body
 
 -- | The default error handler for 'errorHandler'.
 defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
 defaultErrorHandler NotFound = do
     r <- waiRequest
+    let path = BSU.toString $ pathInfo r
     applyLayout' "Not Found" $ [$hamlet|
 %h1 Not Found
-%p $toString.pathInfo.r$
+%p $path$
 |]
   where
     pathInfo = W.pathInfo
@@ -236,7 +306,112 @@
 --
 -- Built on top of 'isAuthorized'. This is useful for building page that only
 -- contain links to pages the user is allowed to see.
-maybeAuthorized :: Yesod a => Route a -> GHandler s a (Maybe (Route a))
-maybeAuthorized r = do
-    x <- isAuthorized r
+maybeAuthorized :: Yesod a
+                => Route a
+                -> Bool -- ^ is this a write request?
+                -> GHandler s a (Maybe (Route a))
+maybeAuthorized r isWrite = do
+    x <- isAuthorized r isWrite
     return $ if x == Authorized then Just r else Nothing
+
+-- | Convert a widget to a 'PageContent'.
+widgetToPageContent :: (Eq (Route master), Yesod master)
+                    => GWidget sub master ()
+                    -> GHandler sub master (PageContent (Route master))
+widgetToPageContent (GWidget w) = do
+    w' <- flip evalStateT 0
+        $ runWriterT $ runWriterT $ runWriterT $ runWriterT
+        $ runWriterT $ runWriterT $ runWriterT w
+    let ((((((((),
+         Body body),
+         Last mTitle),
+         scripts'),
+         stylesheets'),
+         style),
+         jscript),
+         Head head') = w'
+    let title = maybe mempty unTitle mTitle
+    let scripts = map (locationToHamlet . unScript) $ runUniqueList scripts'
+    let stylesheets = map (locationToHamlet . unStylesheet)
+                    $ runUniqueList stylesheets'
+    let cssToHtml (Css b) = Html b
+        celper :: Cassius url -> Hamlet url
+        celper = fmap cssToHtml
+        jsToHtml (Javascript b) = Html b
+        jelper :: Julius url -> Hamlet url
+        jelper = fmap jsToHtml
+
+    render <- getUrlRenderParams
+    let renderLoc x =
+            case x of
+                Nothing -> Nothing
+                Just (Left s) -> Just s
+                Just (Right (u, p)) -> Just $ render u p
+    cssLoc <-
+        case style of
+            Nothing -> return Nothing
+            Just s -> do
+                x <- addStaticContent "css" "text/css; charset=utf-8"
+                   $ renderCassius render s
+                return $ renderLoc x
+    jsLoc <-
+        case jscript of
+            Nothing -> return Nothing
+            Just s -> do
+                x <- addStaticContent "js" "text/javascript; charset=utf-8"
+                   $ renderJulius render s
+                return $ renderLoc x
+
+    let head'' = [$hamlet|
+$forall scripts s
+    %script!src=^s^
+$forall stylesheets s
+    %link!rel=stylesheet!href=^s^
+$maybe style s
+    $maybe cssLoc s
+        %link!rel=stylesheet!href=$s$
+    $nothing
+        %style ^celper.s^
+$maybe jscript j
+    $maybe jsLoc s
+        %script!src=$s$
+    $nothing
+        %script ^jelper.j^
+^head'^
+|]
+    return $ PageContent title head'' body
+
+#if TEST
+testSuite :: Test
+testSuite = testGroup "Yesod.Yesod"
+    [ testProperty "join/split path" propJoinSplitPath
+    , testCase "utf8 split path" caseUtf8SplitPath
+    , testCase "utf8 join path" caseUtf8JoinPath
+    ]
+
+data TmpYesod = TmpYesod
+data TmpRoute = TmpRoute deriving Eq
+type instance Route TmpYesod = TmpRoute
+instance Yesod TmpYesod where approot _ = ""
+
+propJoinSplitPath ss =
+    splitPath TmpYesod (BSU.fromString $ joinPath TmpYesod "" ss' [])
+        == Right ss'
+  where
+    ss' = filter (not . null) ss
+
+caseUtf8SplitPath :: Assertion
+caseUtf8SplitPath = do
+    Right ["שלום"] @=?
+        splitPath TmpYesod (BSU.fromString "/שלום/")
+    Right ["page", "Fooé"] @=?
+        splitPath TmpYesod (BSU.fromString "/page/Fooé/")
+    Right ["\156"] @=?
+        splitPath TmpYesod (BSU.fromString "/\156/")
+    Right ["ð"] @=?
+        splitPath TmpYesod (BSU.fromString "/%C3%B0/")
+
+caseUtf8JoinPath :: Assertion
+caseUtf8JoinPath = do
+    "/%D7%A9%D7%9C%D7%95%D7%9D/" @=? joinPath TmpYesod "" ["שלום"] []
+#endif
diff --git a/favicon.ico b/favicon.ico
new file mode 100644
Binary files /dev/null and b/favicon.ico differ
diff --git a/runtests.hs b/runtests.hs
--- a/runtests.hs
+++ b/runtests.hs
@@ -4,6 +4,7 @@
 import qualified Yesod.Json
 import qualified Yesod.Dispatch
 import qualified Yesod.Helpers.Static
+import qualified Yesod.Yesod
 
 main :: IO ()
 main = defaultMain
@@ -11,4 +12,5 @@
     , Yesod.Json.testSuite
     , Yesod.Dispatch.testSuite
     , Yesod.Helpers.Static.testSuite
+    , Yesod.Yesod.testSuite
     ]
diff --git a/scaffold.hs b/scaffold.hs
--- a/scaffold.hs
+++ b/scaffold.hs
@@ -1,13 +1,14 @@
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
 import CodeGenQ
 import System.IO
 import System.Directory
+import qualified Data.ByteString.Char8 as S
+import Language.Haskell.TH.Syntax
 
 main :: IO ()
 main = do
     putStr [$codegen|Welcome to the Yesod scaffolder.
 I'm going to be creating a skeleton Yesod project for you.
-Please make sure you are in the directory where you'd like the files created.
 
 What is your name? We're going to put this in the cabal and LICENSE files.
 
@@ -17,26 +18,80 @@
 
     putStr [$codegen|
 Welcome ~name~.
-What do you want to call your project? We'll use this for the cabal name and
-executable filenames.
+What do you want to call your project? We'll use this for the cabal name.
 
 Project name: |]
     hFlush stdout
     project <- getLine
+
     putStr [$codegen|
-Great, we'll be creating ~project~ today. What's going to be the name of
-your site argument datatype? This name must start with a capital letter;
-I recommend picking something short, as this name gets typed a lot.
+Now where would you like me to place your generated files? I'm smart enough
+to create the directories, don't worry about that. If you leave this answer
+blank, we'll place the files in ~project~.
 
+Directory name: |]
+    hFlush stdout
+    dirRaw <- getLine
+    let dir = if null dirRaw then project else dirRaw
+
+    putStr [$codegen|
+Great, we'll be creating ~project~ today, and placing it in ~dir~.
+What's going to be the name of your site argument datatype? This name must
+start with a capital letter.
+
 Site argument: |]
     hFlush stdout
     sitearg <- getLine
+
     putStr [$codegen|
 That's it! I'm creating your files now...
 |]
 
-    putStrLn $ "Generating " ++ project ++ ".cabal"
-    writeFile (project ++ ".cabal") [$codegen|
+    putStr [$codegen|
+Yesod uses Persistent for its (you guessed it) persistence layer.
+This tool will build in either SQLite or PostgreSQL support for you. If you
+want to use a different backend, you'll have to make changes manually.
+If you're not sure, stick with SQLite: it has no dependencies.
+
+So, what'll it be? s for sqlite, p for postgresql: |]
+    hFlush stdout
+    backendS <- getLine
+    let pconn1 = [$codegen|user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_debug|]
+    let pconn2 = [$codegen|user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_production|]
+    let (lower, upper, connstr1, connstr2) =
+            case backendS of
+                "s" -> ("sqlite", "Sqlite", "debug.db3", "production.db3")
+                "p" -> ("postgresql", "Postgresql", pconn1, pconn2)
+                _ -> error $ "Invalid backend: " ++ backendS
+
+
+    let writeFile' fp s = do
+            putStrLn $ "Generating " ++ fp
+            writeFile (dir ++ '/' : fp) s
+        mkDir fp = createDirectoryIfMissing True $ dir ++ '/' : fp
+
+    mkDir "Handler"
+    mkDir "hamlet"
+    mkDir "cassius"
+    mkDir "julius"
+
+    writeFile' "simple-server.hs" [$codegen|
+import Controller
+import Network.Wai.Handler.SimpleServer (run)
+
+main :: IO ()
+main = putStrLn "Loaded" >> with~sitearg~ (run 3000)
+|]
+
+    writeFile' "fastcgi.hs" [$codegen|
+import Controller
+import Network.Wai.Handler.FastCGI (run)
+
+main :: IO ()
+main = with~sitearg~ run
+|]
+
+    writeFile' (project ++ ".cabal") [$codegen|
 name:              ~project~
 version:           0.0.0
 license:           BSD3
@@ -51,16 +106,39 @@
 build-type:        Simple
 homepage:          http://www.yesodweb.com/~project~
 
-executable         ~project~
+Flag production
+    Description:   Build the production executable.
+    Default:       False
+
+executable         simple-server
+    if flag(production)
+        Buildable: False
+    main-is:       simple-server.hs
     build-depends: base >= 4 && < 5,
-                   yesod >= 0.4.0 && < 0.5.0,
-                   persistent-sqlite >= 0.1.0 && < 0.2
+                   yesod >= 0.5 && < 0.6,
+                   wai-extra,
+                   directory,
+                   bytestring,
+                   persistent,
+                   persistent-sqlite,
+                   template-haskell,
+                   hamlet
     ghc-options:   -Wall
-    main-is:       ~project~.hs
+    extensions:    TemplateHaskell, QuasiQuotes, TypeFamilies
+
+executable         fastcgi
+    if flag(production)
+        Buildable: True
+    else
+        Buildable: False
+    cpp-options:   -DPRODUCTION
+    main-is:       fastcgi.hs
+    build-depends: wai-handler-fastcgi
+    ghc-options:   -Wall
+    extensions:    TemplateHaskell, QuasiQuotes, TypeFamilies
 |]
 
-    putStrLn "Generating LICENSE"
-    writeFile "LICENSE" [$codegen|
+    writeFile' "LICENSE" [$codegen|
 The following license covers this documentation, and the source code, except
 where otherwise indicated.
 
@@ -88,113 +166,343 @@
 ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 |]
 
-    putStrLn ("Generating " ++ project ++ ".hs")
-    writeFile (project ++ ".hs") [$codegen|
-import Yesod
-import App
-
-main :: IO ()
-main = with~sitearg~ $ basicHandler 3000
-|]
-
-    putStrLn "Generating App.hs"
-    writeFile "App.hs" [$codegen|
-{-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings #-}
-module App
+    writeFile' (sitearg ++ ".hs") [$codegen|
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
+module ~sitearg~
     ( ~sitearg~ (..)
-    , with~sitearg~
+    , ~sitearg~Route (..)
+    , resources~sitearg~
+    , Handler
+    , maybeAuth
+    , requireAuth
+    , module Yesod
+    , module Settings
+    , module Model
+    , StaticRoute (..)
+    , AuthRoute (..)
     ) where
+
 import Yesod
-import Yesod.Helpers.Crud
+import Yesod.Mail
 import Yesod.Helpers.Static
-import Database.Persist.Sqlite
+import Yesod.Helpers.Auth
+import qualified Settings
+import System.Directory
+import qualified Data.ByteString.Lazy as L
+import Yesod.WebRoutes
+import Database.Persist.GenericSql
+import Settings (hamletFile, cassiusFile, juliusFile)
 import Model
+import Control.Monad (join)
+import Data.Maybe (isJust)
 
 data ~sitearg~ = ~sitearg~
-    { connPool :: Pool Connection
-    , static :: Static
+    { getStatic :: Static
+    , connPool :: Settings.ConnectionPool
     }
 
-with~sitearg~ :: (~sitearg~ -> IO a) -> IO a
-with~sitearg~ f = withSqlite "~project~.db3" 8 $ \pool -> do
-    flip runSqlite pool $ do
-        -- This is where you can initialize your database.
-        initialize (undefined :: Person)
-    f $ ~sitearg~ pool $ fileLookupDir "static" typeByExt
+type Handler = GHandler ~sitearg~ ~sitearg~
 
-type PersonCrud = Crud ~sitearg~ Person
+mkYesodData "~sitearg~" [$parseRoutes|
+/static StaticR Static getStatic
+/auth   AuthR   Auth   getAuth
 
-mkYesod "~sitearg~" [$parseRoutes|
-/       RootR   GET
-/people PeopleR PersonCrud defaultCrud
-/static StaticR Static static
+/favicon.ico FaviconR GET
+/robots.txt RobotsR GET
+
+/ RootR GET
 |~~]
 
 instance Yesod ~sitearg~ where
-    approot _ = "http://localhost:3000"
-    defaultLayout (PageContent title head' body) = hamletToContent [$hamlet|
-!!!
-%html
-    %head
-        %title $title$
-        %link!rel=stylesheet!href=@stylesheet@
-        ^head'^
-    %body
-        #wrapper
-            ^body^
-|~~]
+    approot _ = Settings.approot
+    defaultLayout widget = do
+        mmsg <- getMessage
+        pc <- widgetToPageContent $ do
+            widget
+            addStyle $(Settings.cassiusFile "default-layout")
+        hamletToRepHtml $(Settings.hamletFile "default-layout")
+    urlRenderOverride a (StaticR s) =
+        Just $ uncurry (joinPath a Settings.staticroot) $ format s
       where
-        stylesheet = StaticR $ StaticRoute ["style.css"]
+        format = formatPathSegments ss
+        ss :: Site StaticRoute (String -> Maybe (GHandler Static ~sitearg~ ChooseRep))
+        ss = getSubSite
+    urlRenderOverride _ _ = Nothing
+    authRoute _ = Just $ AuthR LoginR
+    addStaticContent ext' _ content = do
+        let fn = base64md5 content ++ '.' : ext'
+        let statictmp = Settings.staticdir ++ "/tmp/"
+        liftIO $ createDirectoryIfMissing True statictmp
+        liftIO $ L.writeFile (statictmp ++ fn) content
+        return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])
 
 instance YesodPersist ~sitearg~ where
-    type YesodDB ~sitearg~ = SqliteReader
-    runDB db = fmap connPool getYesod >>= runSqlite db
+    type YesodDB ~sitearg~ = SqlPersist
+    runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db
 
-getRootR :: Handler ~sitearg~ RepHtml
-getRootR = applyLayoutW $ do
-    setTitle "Welcome to the ~project~ project"
-    addBody [$hamlet|
-%h1 Welcome to ~project~
-%h2 The greatest Yesod web application ever!
+instance YesodAuth ~sitearg~ where
+    type AuthEntity ~sitearg~ = User
+    type AuthEmailEntity ~sitearg~ = Email
+
+    defaultDest _ = RootR
+
+    getAuthId creds _extra = runDB $ do
+        x <- getBy $ UniqueUser $ credsIdent creds
+        case x of
+            Just (uid, _) -> return $ Just uid
+            Nothing -> do
+                fmap Just $ insert $ User (credsIdent creds) Nothing
+
+    openIdEnabled _ = True
+
+    emailSettings _ = Just EmailSettings
+        { addUnverified = \email verkey ->
+            runDB $ insert $ Email email Nothing (Just verkey)
+        , sendVerifyEmail = sendVerifyEmail'
+        , getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get
+        , setVerifyKey = \eid key -> runDB $ update eid [EmailVerkey $ Just key]
+        , verifyAccount = \eid -> runDB $ do
+            me <- get eid
+            case me of
+                Nothing -> return Nothing
+                Just e -> do
+                    let email = emailEmail e
+                    case emailUser e of
+                        Just uid -> return $ Just uid
+                        Nothing -> do
+                            uid <- insert $ User email Nothing
+                            update eid [EmailUser $ Just uid]
+                            return $ Just uid
+        , getPassword = runDB . fmap (join . fmap userPassword) . get
+        , setPassword = \uid pass -> runDB $ update uid [UserPassword $ Just pass]
+        , getEmailCreds = \email -> runDB $ do
+            me <- getBy $ UniqueEmail email
+            case me of
+                Nothing -> return Nothing
+                Just (eid, e) -> return $ Just EmailCreds
+                    { emailCredsId = eid
+                    , emailCredsAuthId = emailUser e
+                    , emailCredsStatus = isJust $ emailUser e
+                    , emailCredsVerkey = emailVerkey e
+                    }
+        , getEmail = runDB . fmap (fmap emailEmail) . get
+        }
+
+sendVerifyEmail' :: String -> String -> String -> GHandler Auth m ()
+sendVerifyEmail' email _ verurl =
+    liftIO $ renderSendMail Mail
+            { mailHeaders =
+                [ ("From", "noreply")
+                , ("To", email)
+                , ("Subject", "Verify your email address")
+                ]
+            , mailPlain = verurl
+            , mailParts = return Part
+                { partType = "text/html; charset=utf-8"
+                , partEncoding = None
+                , partDisposition = Inline
+                , partContent = renderHamlet id [$hamlet|
+%p Please confirm your email address by clicking on the link below.
 %p
-    %a!href=@PeopleR.CrudListR@ Manage people
+    %a!href=$verurl$ $verurl$
+%p Thank you
 |~~]
+                }
+            }
 |]
 
-    putStrLn "Generating Model.hs"
-    writeFile "Model.hs" [$codegen|
-{-# LANGUAGE GeneralizedNewtypeDeriving, QuasiQuotes, TypeFamilies #-}
+    writeFile' "Controller.hs" [$codegen|
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Controller
+    ( with~sitearg~
+    ) where
 
--- We don't explicitly state our export list, since there are funny things
--- that happen with type family constructors.
+import ~sitearg~
+import Settings
+import Yesod.Helpers.Static
+import Yesod.Helpers.Auth
+import Database.Persist.GenericSql
+
+import Handler.Root
+
+mkYesodDispatch "~sitearg~" resources~sitearg~
+
+getFaviconR :: Handler ()
+getFaviconR = sendFile "image/x-icon" "favicon.ico"
+
+getRobotsR :: Handler RepPlain
+getRobotsR = return $ RepPlain $ toContent "User-agent: *"
+
+with~sitearg~ :: (Application -> IO a) -> IO a
+with~sitearg~ f = Settings.withConnectionPool $ \p -> do
+    flip runConnectionPool p $ runMigration $ do
+        migrate (undefined :: User)
+        migrate (undefined :: Email)
+    let h = ~sitearg~ s p
+    toWaiApp h >>= f
+  where
+    s = fileLookupDir Settings.staticdir typeByExt
+|]
+
+    writeFile' "Handler/Root.hs" [$codegen|
+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
+module Handler.Root where
+
+import ~sitearg~
+
+getRootR :: Handler RepHtml
+getRootR = do
+    mu <- maybeAuth
+    defaultLayout $ do
+        h2id <- newIdent
+        setTitle "~project~ homepage"
+        addBody $(hamletFile "homepage")
+        addStyle $(cassiusFile "homepage")
+        addJavascript $(juliusFile "homepage")
+|]
+
+    writeFile' "Model.hs" [$codegen|
+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}
 module Model where
 
 import Yesod
-import Yesod.Helpers.Crud
 
-share2 mkPersist mkToForm [$persist|
-Person
-    name String
-    age Int
+mkPersist [$persist|
+User
+    ident String
+    password String null update
+    UniqueUser ident
+Email
+    email String
+    user UserId null update
+    verkey String null update
+    UniqueEmail email
 |~~]
+|]
 
-instance Item Person where
-    itemTitle = personName
+    writeFile' "Settings.hs" [$codegen|
+{-# LANGUAGE CPP #-}
+module Settings
+    ( hamletFile
+    , cassiusFile
+    , juliusFile
+    , connStr
+    , ConnectionPool
+    , withConnectionPool
+    , runConnectionPool
+    , approot
+    , staticroot
+    , staticdir
+    ) where
+
+import qualified Text.Hamlet as H
+import qualified Text.Cassius as H
+import qualified Text.Julius as H
+import Language.Haskell.TH.Syntax
+import Database.Persist.Sqlite
+import Yesod (MonadCatchIO)
+
+hamletFile :: FilePath -> Q Exp
+#ifdef PRODUCTION
+hamletFile x = H.hamletFile $ "hamlet/" ++ x ++ ".hamlet"
+#else
+hamletFile x = H.hamletFileDebug $ "hamlet/" ++ x ++ ".hamlet"
+#endif
+
+cassiusFile :: FilePath -> Q Exp
+#ifdef PRODUCTION
+cassiusFile x = H.cassiusFile $ "cassius/" ++ x ++ ".cassius"
+#else
+cassiusFile x = H.cassiusFileDebug $ "cassius/" ++ x ++ ".cassius"
+#endif
+
+juliusFile :: FilePath -> Q Exp
+#ifdef PRODUCTION
+juliusFile x = H.juliusFile $ "julius/" ++ x ++ ".julius"
+#else
+juliusFile x = H.juliusFileDebug $ "julius/" ++ x ++ ".julius"
+#endif
+
+connStr :: String
+#ifdef PRODUCTION
+connStr = "production.db3"
+#else
+connStr = "debug.db3"
+#endif
+
+connectionCount :: Int
+connectionCount = 10
+
+withConnectionPool :: MonadCatchIO m => (ConnectionPool -> m a) -> m a
+withConnectionPool = withSqlitePool connStr connectionCount
+
+runConnectionPool :: MonadCatchIO m => SqlPersist m a -> ConnectionPool -> m a
+runConnectionPool = runSqlPool
+
+approot :: String
+#ifdef PRODUCTION
+approot = "http://localhost:3000"
+#else
+approot = "http://localhost:3000"
+#endif
+
+staticroot :: String
+staticroot = approot ++ "/static"
+
+staticdir :: FilePath
+staticdir = "static"
 |]
 
-    putStrLn "Generating static/style.css"
-    createDirectoryIfMissing True "static"
-    writeFile "static/style.css" [$codegen|
-body {
-    font-family: sans-serif;
-    background: #eee;
-}
+    writeFile' "cassius/default-layout.cassius" [$codegen|
+body
+    font-family: sans-serif
+|]
 
-#wrapper {
-    width: 760px;
-    margin: 1em auto;
-    border: 2px solid #000;
-    padding: 0.5em;
-    background: #fff;
+    writeFile' "hamlet/default-layout.hamlet" [$codegen|
+!!!
+%html
+    %head
+        %title $pageTitle.pc$
+        ^pageHead.pc^
+    %body
+        $maybe mmsg msg
+            #message $msg$
+        ^pageBody.pc^
+|]
+
+    writeFile' "hamlet/homepage.hamlet" [$codegen|
+%h1 Hello
+%h2#$h2id$ You do not have Javascript enabled.
+$maybe mu u
+    %p
+        You are logged in as $userIdent.snd.u$. $
+        %a!href=@AuthR.LogoutR@ Logout
+        \.
+$nothing
+    %p
+        You are not logged in. $
+        %a!href=@AuthR.LoginR@ Login now
+        \.
+|]
+
+    writeFile' "cassius/homepage.cassius" [$codegen|
+body
+    font-family: sans-serif
+h1
+    text-align: center
+h2#$h2id$
+    color: #990
+|]
+
+    writeFile' "julius/homepage.julius" [$codegen|
+window.onload = function(){
+    document.getElementById("%h2id%").innerHTML = "<i>Added from JavaScript.</i>";
 }
 |]
+
+    S.writeFile (dir ++ "/favicon.ico")
+        $(runIO (S.readFile "favicon.ico") >>= \bs -> do
+            pack <- [|S.pack|]
+            return $ pack `AppE` LitE (StringL $ S.unpack bs))
diff --git a/yesod.cabal b/yesod.cabal
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -1,5 +1,5 @@
 name:            yesod
-version:         0.4.1
+version:         0.5.0
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -14,6 +14,7 @@
 cabal-version:   >= 1.6
 build-type:      Simple
 homepage:        http://docs.yesodweb.com/yesod/
+extra-source-files: favicon.ico
 
 flag buildtests
   description: Build the executable to run unit tests
@@ -23,36 +24,46 @@
     build-depends:   base >= 4 && < 5,
                      time >= 1.1.4 && < 1.3,
                      wai >= 0.2.0 && < 0.3,
-                     wai-extra >= 0.2.0 && < 0.3,
+                     wai-extra >= 0.2.2 && < 0.3,
                      authenticate >= 0.6.3 && < 0.7,
                      bytestring >= 0.9.1.4 && < 0.10,
                      directory >= 1 && < 1.1,
                      text >= 0.5 && < 0.8,
                      utf8-string >= 0.3.4 && < 0.4,
                      template-haskell >= 2.4 && < 2.5,
-                     web-routes >= 0.22 && < 0.23,
-                     web-routes-quasi >= 0.5 && < 0.6,
-                     hamlet >= 0.4.0 && < 0.5,
+                     web-routes-quasi >= 0.6 && < 0.7,
+                     hamlet >= 0.5.0 && < 0.6,
+                     blaze-builder >= 0.1 && < 0.2,
                      transformers >= 0.2 && < 0.3,
                      clientsession >= 0.4.0 && < 0.5,
                      pureMD5 >= 1.1.0.0 && < 1.2,
                      random >= 1.0.0.2 && < 1.1,
                      control-monad-attempt >= 0.3 && < 0.4,
                      cereal >= 0.2 && < 0.3,
+                     dataenc >= 0.13.0.2 && < 0.14,
                      old-locale >= 1.0.0.2 && < 1.1,
-                     persistent >= 0.1.0 && < 0.2,
+                     persistent >= 0.2.0 && < 0.3,
                      neither >= 0.0.0 && < 0.1,
                      MonadCatchIO-transformers >= 0.2.2.0 && < 0.3,
                      data-object >= 0.3.1 && < 0.4,
-                     email-validate >= 0.2.5 && < 0.3
+                     network >= 2.2.1.5 && < 2.3,
+                     email-validate >= 0.2.5 && < 0.3,
+                     process >= 1.0.1 && < 1.1
     exposed-modules: Yesod
                      Yesod.Content
                      Yesod.Dispatch
                      Yesod.Form
+                     Yesod.Form.Class
+                     Yesod.Form.Core
+                     Yesod.Form.Fields
+                     Yesod.Form.Profiles
+                     Yesod.Form.Jquery
+                     Yesod.Form.Nic
                      Yesod.Hamlet
                      Yesod.Handler
                      Yesod.Internal
                      Yesod.Json
+                     Yesod.Mail
                      Yesod.Request
                      Yesod.Widget
                      Yesod.Yesod
@@ -61,6 +72,7 @@
                      Yesod.Helpers.Crud
                      Yesod.Helpers.Sitemap
                      Yesod.Helpers.Static
+                     Yesod.WebRoutes
     ghc-options:     -Wall
 
 executable             yesod