diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,7 +1,7 @@
 The following license covers this documentation, and the source code, except
 where otherwise indicated.
 
-Copyright 2009, Michael Snoyman. All rights reserved.
+Copyright 2010, Michael Snoyman. All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are met:
diff --git a/Yesod.hs b/Yesod.hs
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -1,8 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
 module Yesod
-    (
-      module Yesod.Request
+    ( module Yesod.Request
     , module Yesod.Content
     , module Yesod.Yesod
     , module Yesod.Handler
@@ -10,10 +9,10 @@
     , module Yesod.Form
     , module Yesod.Hamlet
     , module Yesod.Json
-    , module Yesod.Formable
+    , module Yesod.Widget
     , Application
     , liftIO
-    , Routes
+    , mempty
     ) where
 
 #if TEST
@@ -27,11 +26,11 @@
 #endif
 
 import Yesod.Request
-import Yesod.Form hiding (Form)
-import Yesod.Formable
+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.IO.Class (liftIO)
-import Web.Routes.Quasi (Routes)
+import Data.Monoid (mempty)
diff --git a/Yesod/Content.hs b/Yesod/Content.hs
--- a/Yesod/Content.hs
+++ b/Yesod/Content.hs
@@ -8,7 +8,7 @@
 
 module Yesod.Content
     ( -- * Content
-      Content (..)
+      Content
     , emptyContent
     , ToContent (..)
       -- * Mime types
@@ -56,7 +56,6 @@
 import qualified Data.Text as T
 
 import qualified Network.Wai as W
-import qualified Network.Wai.Enumerator as WE
 
 import Data.Time
 import System.Locale
@@ -72,35 +71,29 @@
 import Test.HUnit hiding (Test)
 #endif
 
--- | There are two different methods available for providing content in the
--- response: via files and enumerators. The former allows server to use
--- optimizations (usually the sendfile system call) for serving static files.
--- The latter is a space-efficient approach to content.
---
--- It can be tedious to write enumerators; often times, you will be well served
--- to use 'toContent'.
-data Content = ContentFile FilePath
-             | ContentEnum (forall a.
-                             (a -> B.ByteString -> IO (Either a a))
-                          -> a
-                          -> IO (Either a a))
+type Content = W.ResponseBody
 
+-- | Zero-length enumerator.
 emptyContent :: Content
-emptyContent = ContentEnum $ \_ -> return . Right
+emptyContent = W.ResponseLBS L.empty
 
+-- | Anything which can be converted into 'Content'. Most of the time, you will
+-- want to use the 'ContentEnum' constructor. An easier approach will be to use
+-- a pre-defined 'toContent' function, such as converting your data into a lazy
+-- bytestring and then calling 'toContent' on that.
 class ToContent a where
     toContent :: a -> Content
 
 instance ToContent B.ByteString where
-    toContent bs = ContentEnum $ \f a -> f a bs
+    toContent = W.ResponseLBS . L.fromChunks . return
 instance ToContent L.ByteString where
-    toContent = swapEnum . WE.fromLBS
+    toContent = W.ResponseLBS
 instance ToContent T.Text where
     toContent = toContent . Data.Text.Encoding.encodeUtf8
 instance ToContent Text where
-    toContent = toContent . Data.Text.Lazy.Encoding.encodeUtf8
+    toContent = W.ResponseLBS . Data.Text.Lazy.Encoding.encodeUtf8
 instance ToContent String where
-    toContent = toContent . Data.ByteString.Lazy.UTF8.fromString
+    toContent = W.ResponseLBS . Data.ByteString.Lazy.UTF8.fromString
 
 -- | A function which gives targetted representations of content based on the
 -- content-types the user accepts.
@@ -108,9 +101,6 @@
     [ContentType] -- ^ list of content-types user accepts, ordered by preference
  -> IO (ContentType, Content)
 
-swapEnum :: W.Enumerator -> Content
-swapEnum (W.Enumerator e) = ContentEnum e
-
 -- | Any type which can be converted to representations.
 class HasReps a where
     chooseRep :: a -> ChooseRep
@@ -140,6 +130,9 @@
 instance HasReps () where
     chooseRep = defChooseRep [(typePlain, const $ return $ toContent "")]
 
+instance HasReps (ContentType, Content) where
+    chooseRep = const . return
+
 instance HasReps [(ContentType, Content)] where
     chooseRep a cts = return $
         case filter (\(ct, _) -> go ct `elem` map go cts) a of
@@ -218,19 +211,20 @@
 simpleContentType :: String -> String
 simpleContentType = fst . span (/= ';')
 
--- | Determine a mime-type based on the file extension.
-typeByExt :: String -> ContentType
-typeByExt "jpg" = typeJpeg
-typeByExt "jpeg" = typeJpeg
-typeByExt "js" = typeJavascript
-typeByExt "css" = typeCss
-typeByExt "html" = typeHtml
-typeByExt "png" = typePng
-typeByExt "gif" = typeGif
-typeByExt "txt" = typePlain
-typeByExt "flv" = typeFlv
-typeByExt "ogv" = typeOgv
-typeByExt _ = typeOctet
+-- | A default extension to mime-type dictionary.
+typeByExt :: [(String, ContentType)]
+typeByExt =
+    [ ("jpg", typeJpeg)
+    , ("jpeg", typeJpeg)
+    , ("js", typeJavascript)
+    , ("css", typeCss)
+    , ("html", typeHtml)
+    , ("png", typePng)
+    , ("gif", typeGif)
+    , ("txt", typePlain)
+    , ("flv", typeFlv)
+    , ("ogv", typeOgv)
+    ]
 
 -- | Get a file extension (everything after last period).
 ext :: String -> String
diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Yesod.Dispatch
     ( -- * Quasi-quoted routing
       parseRoutes
@@ -16,9 +17,9 @@
       -- * Convert to WAI
     , toWaiApp
     , basicHandler
+    , basicHandler'
       -- * Utilities
     , fullRender
-    , quasiRender
 #if TEST
     , testSuite
 #endif
@@ -30,6 +31,9 @@
 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 qualified Network.Wai as W
@@ -55,10 +59,13 @@
 import Data.Maybe
 import Web.ClientSession
 import qualified Web.ClientSession as CS
+import Data.Char (isLower, isUpper)
 
 import Data.Serialize
 import qualified Data.Serialize as Ser
-import Network.Wai.Parse
+import Network.Wai.Parse hiding (FileInfo)
+import qualified Network.Wai.Parse as NWP
+import Data.String (fromString)
 
 #if TEST
 import Test.Framework (testGroup, Test)
@@ -73,7 +80,7 @@
 #endif
 
 -- | Generates URL datatype and site function for the given 'Resource's. This
--- is used for creating sites, *not* subsites. See 'mkYesodSub' for the latter.
+-- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
 -- Use 'parseRoutes' to create the 'Resource's.
 mkYesod :: String -- ^ name of the argument datatype
         -> [Resource]
@@ -81,7 +88,7 @@
 mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False
 
 -- | Generates URL datatype and site function for the given 'Resource's. This
--- is used for creating subsites, *not* sites. See 'mkYesod' for the latter.
+-- is used for creating subsites, /not/ sites. See 'mkYesod' for the latter.
 -- Use 'parseRoutes' to create the 'Resource's. In general, a subsite is not
 -- executable by itself, but instead provides functionality to
 -- be embedded in other sites.
@@ -96,13 +103,13 @@
 
 -- | Sometimes, you will want to declare your routes in one file and define
 -- your handlers elsewhere. For example, this is the only way to break up a
--- monolithic file into smaller parts. This function, paired with
--- 'mkYesodDispatch', do just that.
+-- monolithic file into smaller parts. Use this function, paired with
+-- 'mkYesodDispatch', to do just that.
 mkYesodData :: String -> [Resource] -> Q [Dec]
 mkYesodData name res = do
     (x, _) <- mkYesodGeneral name [] [] False res
     let rname = mkName $ "resources" ++ name
-    eres <- liftResources res
+    eres <- lift res
     let y = [ SigD rname $ ListT `AppT` ConT ''Resource
             , FunD rname [Clause [] (NormalB eres) []]
             ]
@@ -112,17 +119,14 @@
 mkYesodDispatch :: String -> [Resource] -> Q [Dec]
 mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False
 
-explodeHandler :: HasReps c
-               => GHandler sub master c
-               -> (Routes master -> String)
-               -> Routes sub
-               -> (Routes sub -> Routes master)
-               -> master
-               -> (master -> sub)
-               -> YesodApp
-               -> String
-               -> YesodApp
-explodeHandler a b c d e f _ _ = runHandler a b (Just c) d e f
+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
@@ -134,27 +138,80 @@
     let name' = mkName name
         args' = map mkName args
         arg = foldl AppT (ConT name') $ map VarT args'
-    let site = mkName $ "site" ++ name
-    let gsbod = NormalB $ VarE site
-    let yes' = FunD (mkName "getSite") [Clause [] gsbod []]
-    let yes = InstanceD [] (ConT ''YesodSite `AppT` ConT name') [yes']
-    let clazzes' = compact
-                 $ map (\x -> (x, [])) ("master" : args) ++
-                   clazzes
-    explode <- [|explodeHandler|]
-    QuasiSiteDecs w x y z <- createQuasiSite QuasiSiteSettings
-                { crRoutes = mkName $ name ++ "Routes"
-                , crApplication = ConT ''YesodApp
-                , crArgument = arg
-                , crExplode = explode
-                , crResources = res
-                , crSite = site
-                , crMaster = if isSub
-                                then Right clazzes'
-                                else Left (ConT name')
-                }
-    return ([w, x], (if isSub then id else (:) yes) [y, z])
+    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"
+    let w = DataD [] routesName [] w' [''Show, ''Read, ''Eq]
+    let x = TySynInstD ''Route [arg] $ ConT routesName
 
+    parse' <- createParse th
+    parse'' <- newName "parse"
+    let parse = LetE [FunD parse'' parse'] $ VarE parse''
+
+    render' <- createRender th
+    render'' <- newName "render"
+    let render = LetE [FunD render'' render'] $ VarE render''
+
+    tmh <- [|toMasterHandler|]
+    modMaster <- [|fmap chooseRep|]
+    dispatch' <- createDispatch modMaster tmh th
+    dispatch'' <- newName "dispatch"
+    let dispatch = LetE [FunD dispatch'' dispatch'] $ LamE [WildP] $ VarE dispatch''
+
+    site <- [|Site|]
+    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")
+                else ([], ConT ''YesodSite `AppT` arg, "getSite")
+    let y = InstanceD ctx ytyp
+                [ FunD (mkName yfunc) [Clause [] (NormalB site') []]
+                ]
+    return ([w, x], [y])
+
+isStatic :: Piece -> Bool
+isStatic StaticPiece{} = True
+isStatic _ = False
+
+fromStatic :: Piece -> String
+fromStatic (StaticPiece s) = s
+fromStatic _ = error "fromStatic"
+
+thResourceFromResource :: Type -> Resource -> Q THResource
+thResourceFromResource _ (Resource n ps attribs)
+    | all (all isUpper) attribs = return (n, Simple ps attribs)
+thResourceFromResource master (Resource n ps atts@[stype, toSubArg])
+    | all isStatic ps && any (any isLower) atts = do
+        let stype' = ConT $ mkName stype
+        gss <- [|getSubSite|]
+        let inside = ConT ''Maybe `AppT`
+                     (ConT ''GHandler `AppT` stype' `AppT` master `AppT`
+                      ConT ''ChooseRep)
+        let typ = ConT ''Site `AppT`
+                  (ConT ''Route `AppT` stype') `AppT`
+                  (ArrowT `AppT` ConT ''String `AppT` inside)
+        let gss' = gss `SigE` typ
+        parse' <- [|parsePathSegments|]
+        let parse = parse' `AppE` gss'
+        render' <- [|formatPathSegments|]
+        let render = render' `AppE` gss'
+        dispatch' <- [|flip handleSite (error "Cannot use subsite render function")|]
+        let dispatch = dispatch' `AppE` gss'
+        return (n, SubSite
+            { ssType = ConT ''Route `AppT` stype'
+            , ssParse = parse
+            , ssRender = render
+            , ssDispatch = dispatch
+            , ssToMasterArg = VarE $ mkName toSubArg
+            , ssPieces = map fromStatic ps
+            })
+thResourceFromResource _ (Resource n _ _) =
+    error $ "Invalid attributes for resource: " ++ n
+
 compact :: [(String, [a])] -> [(String, [a])]
 compact [] = []
 compact ((x, x'):rest) =
@@ -186,62 +243,52 @@
     let exp' = getExpires $ clientSessionDuration y
     let host = W.remoteHost env
     let session' = fromMaybe [] $ do
-            raw <- lookup W.Cookie $ W.requestHeaders env
+            raw <- lookup "Cookie" $ W.requestHeaders env
             val <- lookup (B.pack sessionName) $ parseCookies raw
             decodeSession key' now host val
     let site = getSite
-        method = B.unpack $ W.methodToBS $ W.requestMethod env
+        method = B.unpack $ W.requestMethod env
         types = httpAccept env
         pathSegments = filter (not . null) segments
-        eurl = quasiParse site pathSegments
+        eurl = parsePathSegments site pathSegments
         render u = fromMaybe
-                    (fullRender (approot y) (quasiRender site) u)
+                    (fullRender (approot y) (formatPathSegments site) u)
                     (urlRenderOverride y u)
     rr <- parseWaiRequest env session'
-    onRequest y rr
-    ya <-
-      case eurl of
-        Left _ -> return $ runHandler (errorHandler y NotFound)
-                          render
-                          Nothing
-                          id
-                          y
-                          id
-        Right url -> do
-            auth <- isAuthorized y url
-            case auth of
-                Nothing -> return $ quasiDispatch site
-                                render
-                                url
-                                id
-                                y
-                                id
-                                (badMethodApp method)
-                                method
-                Just msg ->
-                    return $ runHandler
-                                (errorHandler y $ PermissionDenied msg)
-                                render
-                                (Just url)
-                                id
-                                y
-                                id
+    let h = do
+          onRequest
+          case eurl of
+            Left _ -> errorHandler NotFound
+            Right url -> do
+                ar <- isAuthorized url
+                case ar of
+                    Authorized -> return ()
+                    AuthenticationRequired ->
+                        case authRoute y of
+                            Nothing ->
+                                permissionDenied "Authentication required"
+                            Just url' -> do
+                                setUltDest'
+                                redirect RedirectTemporary url'
+                    Unauthorized s -> permissionDenied s
+                case handleSite site render url method of
+                    Nothing -> errorHandler $ BadMethod method
+                    Just h' -> h'
     let eurl' = either (const Nothing) Just eurl
-    let eh er = runHandler (errorHandler y 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
     let hs' = AddCookie (clientSessionDuration y) sessionName
                                                   (S.toString sessionVal)
             : hs
         hs'' = map (headerToPair getExpires) hs'
-        hs''' = (W.ContentType, S.fromString ct) : hs''
-    return $ W.Response s hs''' $ case c of
-                                    ContentFile fp -> Left fp
-                                    ContentEnum e -> Right $ W.Enumerator e
+        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.
+-- 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.
@@ -256,25 +303,37 @@
 httpAccept = map B.unpack
            . parseHttpAccept
            . fromMaybe B.empty
-           . lookup W.Accept
+           . lookup "Accept"
            . W.requestHeaders
 
 -- | Runs an application with CGI if CGI variables are present (namely
 -- PATH_INFO); otherwise uses SimpleServer.
-basicHandler :: Int -- ^ port number
-             -> W.Application -> IO ()
-basicHandler port app = do
+basicHandler :: (Yesod y, YesodSite y)
+             => Int -- ^ port number
+             -> y
+             -> IO ()
+basicHandler port y = basicHandler' port (Just "localhost") y
+
+
+-- | Same as 'basicHandler', but allows you to specify the hostname to display
+-- to the user. If 'Nothing' is provided, then no output is produced.
+basicHandler' :: (Yesod y, YesodSite y)
+              => Int -- ^ port number
+              -> Maybe String -- ^ host name, 'Nothing' to show nothing
+              -> y
+              -> IO ()
+basicHandler' port mhost y = do
+    app <- toWaiApp y
     vars <- getEnvironment
     case lookup "PATH_INFO" vars of
         Nothing -> do
-            putStrLn $ "http://localhost:" ++ show port ++ "/"
+            case mhost of
+                Nothing -> return ()
+                Just h -> putStrLn $ concat
+                    ["http://", h, ":", show port, "/"]
             SS.run port app
         Just _ -> CGI.run app
 
-badMethodApp :: String -> YesodApp
-badMethodApp m = YesodApp $ \eh req cts
-         -> unYesodApp (eh $ BadMethod m) eh req cts
-
 fixSegs :: [String] -> [String]
 fixSegs [] = []
 fixSegs [x]
@@ -288,25 +347,28 @@
 parseWaiRequest env session' = do
     let gets' = map (S.toString *** S.toString)
               $ parseQueryString $ W.queryString env
-    let reqCookie = fromMaybe B.empty $ lookup W.Cookie
+    let reqCookie = fromMaybe B.empty $ lookup "Cookie"
                   $ W.requestHeaders env
         cookies' = map (S.toString *** S.toString) $ parseCookies reqCookie
-        acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env
+        acceptLang = lookup "Accept-Language" $ W.requestHeaders env
         langs = map S.toString $ maybe [] parseHttpAccept acceptLang
-        langs' = case lookup langKey cookies' of
+        langs' = case lookup langKey session' of
                     Nothing -> langs
                     Just x -> x : langs
-        langs'' = case lookup langKey gets' of
-                     Nothing -> langs'
-                     Just x -> x : langs'
+        langs'' = case lookup langKey cookies' of
+                    Nothing -> langs'
+                    Just x -> x : langs'
+        langs''' = case lookup langKey gets' of
+                     Nothing -> langs''
+                     Just x -> x : langs''
     rbthunk <- iothunk $ rbHelper env
-    return $ Request gets' cookies' session' rbthunk env langs''
+    return $ Request gets' cookies' session' rbthunk env langs'''
 
 rbHelper :: W.Request -> IO RequestBodyContents
 rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where
     fix1 = map (S.toString *** S.toString)
-    fix2 (x, FileInfo a b c) =
-        (S.toString x, FileInfo a b c)
+    fix2 (x, NWP.FileInfo a b c) =
+        (S.toString x, FileInfo (S.toString a) (S.toString b) c)
 
 -- | Produces a \"compute on demand\" value. The computation will be run once
 -- it is requested, and then the result will be stored. This will happen only
@@ -327,14 +389,14 @@
              -> (W.ResponseHeader, B.ByteString)
 headerToPair getExpires (AddCookie minutes key value) =
     let expires = getExpires minutes
-     in (W.SetCookie, S.fromString
+     in ("Set-Cookie", S.fromString
                             $ key ++ "=" ++ value ++"; path=/; expires="
                               ++ formatW3 expires)
 headerToPair _ (DeleteCookie key) =
-    (W.SetCookie, S.fromString $
+    ("Set-Cookie", S.fromString $
      key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
 headerToPair _ (Header key value) =
-    (W.responseHeaderFromBS $ S.fromString key, S.fromString value)
+    (fromString key, S.fromString value)
 
 encodeSession :: CS.Key
               -> UTCTime -- ^ expire time
diff --git a/Yesod/Form.hs b/Yesod/Form.hs
--- a/Yesod/Form.hs
+++ b/Yesod/Form.hs
@@ -1,134 +1,889 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PackageImports #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -- | Parse forms (and query strings).
 module Yesod.Form
-    ( Form (..)
-    , runFormGeneric
-    , runFormPost
+    ( -- * Data types
+      GForm (..)
+    , Form
+    , Formlet
+    , FormField
+    , FormletField
+    , FormInput
+    , FormResult (..)
+    , Enctype (..)
+    , FieldInfo (..)
+      -- * Newtype wrappers
+    , JqueryDay (..)
+    , NicHtml (..)
+    , Html'
+      -- * Unwrapping functions
     , runFormGet
-    , input
-    , applyForm
-      -- * Specific checks
-    , required
-    , optional
-    , notEmpty
-    , checkDay
-    , checkBool
-    , checkInteger
-      -- * Utility
-    , catchFormError
+    , 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
+      -- * Template Haskell
+    , share2
+    , mkToForm
     ) where
 
+import Text.Hamlet
 import Yesod.Request
 import Yesod.Handler
 import Control.Applicative hiding (optional)
-import Data.Time (Day)
-import Data.Maybe (fromMaybe)
+import Data.Time (Day, TimeOfDay (TimeOfDay))
+import Data.Maybe (fromMaybe, isJust)
 import "transformers" Control.Monad.IO.Class
-import Yesod.Internal
-import Control.Monad.Attempt
+import Control.Monad ((<=<), liftM, join)
+import Data.Monoid (Monoid (..))
+import Control.Monad.Trans.State
+import Language.Haskell.TH.Syntax
+import Database.Persist.Base (EntityDef (..), PersistField)
+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
 
-noParamNameError :: String
-noParamNameError = "No param name (miscalling of Yesod.Form library)"
+-- | 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
 
-data Form x = Form (
-                (ParamName -> [ParamValue])
-             -> Either [(ParamName, FormError)] (Maybe ParamName, x)
-             )
+-- | 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
 
-instance Functor Form where
-    fmap f (Form x) = Form $ \l -> case x l of
-                                    Left errors -> Left errors
-                                    Right (pn, x') -> Right (pn, f x')
-instance Applicative Form where
-    pure x = Form $ \_ -> Right (Nothing, x)
-    (Form f') <*> (Form x') = Form $ \l -> case (f' l, x' l) of
-        (Right (_, f), Right (_, x)) -> Right (Nothing, f x)
-        (Left e1, Left e2) -> Left $ e1 ++ e2
-        (Left e, _) -> Left e
-        (_, Left e) -> Left e
+-- | 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 ()]
 
-type FormError = String
+-- | 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)
 
-runFormGeneric :: Failure ErrorResponse m
-               => (ParamName -> [ParamValue]) -> Form x -> m x
-runFormGeneric params (Form f) =
-    case f params of
-        Left es -> invalidArgs es
-        Right (_, x) -> return x
+-- | 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)
+
+-- | 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
+
+-- | 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
+  where
+    go fi = do
+        wrapWidget (fiInput fi) $ \w -> [$hamlet|
+%tr
+    %td
+        %label!for=$fiIdent.fi$ $fiLabel.fi$
+        .tooltip $fiTooltip.fi$
+    %td
+        ^w^
+    $maybe fiErrors.fi err
+        %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
+
 -- | Run a form against POST parameters.
-runFormPost :: (RequestReader m, Failure ErrorResponse m, MonadIO m)
-            => Form x -> m x
+runFormPost :: GForm sub y xml a
+            -> GHandler sub y (FormResult a, xml, Enctype)
 runFormPost f = do
     rr <- getRequest
-    pp <- postParams rr
-    runFormGeneric pp f
+    (pp, files) <- liftIO $ reqRequestBody rr
+    runFormGeneric pp files f
 
+-- | Run a form against POST parameters, disregarding the resulting HTML and
+-- returning an error response on invalid input.
+runFormPost' :: GForm sub y xml a -> GHandler sub y a
+runFormPost' = helper <=< runFormPost
+
+-- | Run a form against GET parameters, disregarding the resulting HTML and
+-- returning an error response on invalid input.
+runFormGet' :: GForm sub y xml a -> GHandler sub y a
+runFormGet' = helper <=< runFormGet
+
+helper :: (FormResult a, b, c) -> GHandler sub y a
+helper (FormSuccess a, _, _) = return a
+helper (FormFailure e, _, _) = invalidArgs e
+helper (FormMissing, _, _) = invalidArgs ["No input found"]
+
 -- | Run a form against GET parameters.
-runFormGet :: (RequestReader m, Failure ErrorResponse m)
-           => Form x -> m x
+runFormGet :: GForm sub y xml a
+           -> GHandler sub y (FormResult a, xml, Enctype)
 runFormGet f = do
-    rr <- getRequest
-    runFormGeneric (getParams rr) f
+    gs <- reqGetParams `fmap` getRequest
+    runFormGeneric gs [] f
 
-input :: ParamName -> Form [ParamValue]
-input pn = Form $ \l -> Right (Just pn, l pn)
+-- | 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'
 
-applyForm :: (x -> Either FormError y) -> Form x -> Form y
-applyForm f (Form x') =
-    Form $ \l ->
-        case x' l of
-            Left e -> Left e
-            Right (pn, x) ->
-                case f x of
-                    Left e -> Left [(fromMaybe noParamNameError pn, e)]
-                    Right y -> Right (pn, y)
+-- | 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
+    getLabel (x, _, z) = fromMaybe (toLabel x) $ getLabel' z
+    getLabel' [] = Nothing
+    getLabel' (('l':'a':'b':'e':'l':'=':x):_) = Just x
+    getLabel' (_:x) = getLabel' x
+    getTooltip (_, _, z) = fromMaybe "" $ getTooltip' z
+    getTooltip' (('t':'o':'o':'l':'t':'i':'p':'=':x):_) = Just x
+    getTooltip' (_:x) = getTooltip' x
+    getTooltip' [] = Nothing
+    derive :: EntityDef -> Q Dec
+    derive t = do
+        let cols = map (getLabel &&& getTooltip) $ entityColumns t
+        ap <- [|(<*>)|]
+        just <- [|pure|]
+        nothing <- [|Nothing|]
+        let just' = just `AppE` ConE (mkName $ entityName t)
+        string' <- [|string|]
+        mfx <- [|mapFormXml|]
+        ftt <- [|fieldsToTable|]
+        let go_ = go ap just' string' mfx ftt
+        let c1 = Clause [ ConP (mkName "Nothing") []
+                        ]
+                        (NormalB $ go_ $ zip cols $ map (const nothing) cols)
+                        []
+        xs <- mapM (const $ newName "x") cols
+        let xs' = map (AppE just . VarE) xs
+        let c2 = Clause [ ConP (mkName "Just") [ConP (mkName $ entityName t)
+                            $ map VarP xs]]
+                        (NormalB $ go_ $ zip cols xs')
+                        []
+        return $ InstanceD [] (ConT ''ToForm
+                              `AppT` ConT (mkName $ entityName t))
+            [FunD (mkName "toForm") [c1, c2]]
+    go ap just' string' mfx ftt a =
+        let x = foldl (ap' ap) just' $ map (go' string') a
+         in mfx `AppE` ftt `AppE` x
+    go' string' ((label, tooltip), ex) =
+        let label' = string' `AppE` LitE (StringL label)
+            tooltip' = string' `AppE` LitE (StringL tooltip)
+         in VarE (mkName "toFormField") `AppE` label'
+                `AppE` tooltip' `AppE` ex
+    ap' ap x y = InfixE (Just x) ap (Just y)
 
-required :: Form [ParamValue] -> Form ParamValue
-required = applyForm $ \pvs -> case pvs of
-                [x] -> Right x
-                [] -> Left "No value for required field"
-                _ -> Left "Multiple values for required field"
+toLabel :: String -> String
+toLabel "" = ""
+toLabel (x:rest) = toUpper x : go rest
+  where
+    go "" = ""
+    go (c:cs)
+        | isUpper c = ' ' : c : go cs
+        | otherwise = c : go cs
 
-optional :: Form [ParamValue] -> Form (Maybe ParamValue)
-optional = applyForm $ \pvs -> case pvs of
-                [""] -> Right Nothing
-                [x] -> Right $ Just x
-                [] -> Right Nothing
-                _ -> Left "Multiple values for optional field"
+jqueryAutocompleteField ::
+    Route y -> Html () -> Html () -> FormletField sub y String
+jqueryAutocompleteField src l t =
+    requiredFieldHelper $ (jqueryAutocompleteFieldProfile src)
+        { fpLabel = l
+        , fpTooltip = t
+        }
 
-notEmpty :: Form ParamValue -> Form ParamValue
-notEmpty = applyForm $ \pv ->
-                if null pv
-                    then Left "Value required"
-                    else Right pv
+maybeJqueryAutocompleteField ::
+    Route y -> Html () -> Html () -> FormletField sub y (Maybe String)
+maybeJqueryAutocompleteField src l t =
+    optionalFieldHelper $ (jqueryAutocompleteFieldProfile src)
+        { fpLabel = l
+        , fpTooltip = t
+        }
 
-checkDay :: Form ParamValue -> Form Day
-checkDay = applyForm $ maybe (Left "Invalid day") Right . readMay
-  where
-    readMay s = case reads s of
-                    (x, _):_ -> Just x
-                    [] -> Nothing
+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
+    }
 
-checkBool :: Form [ParamValue] -> Form Bool
-checkBool = applyForm $ \pv -> Right $ case pv of
-                                        [] -> False
-                                        [""] -> False
-                                        ["false"] -> False
-                                        _ -> True
+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
+    }
 
-checkInteger :: Form ParamValue -> Form Integer
-checkInteger = applyForm $ \pv ->
-    case reads pv of
-        [] -> Left "Invalid integer"
-        ((i, _):_) -> Right i
+emailField :: Html () -> Html () -> FormletField sub y String
+emailField label tooltip = requiredFieldHelper emailFieldProfile
+    { fpLabel = label
+    , fpTooltip = tooltip
+    }
 
--- | Instead of calling 'failure' with an 'InvalidArgs', return the error
--- messages.
-catchFormError :: Form x -> Form (Either [(ParamName, FormError)] x)
-catchFormError (Form x) = Form $ \l ->
-    case x l of
-        Left e -> Right (Nothing, Left e)
-        Right (_, v) -> Right (Nothing, Right v)
+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/Formable.hs b/Yesod/Formable.hs
deleted file mode 100644
--- a/Yesod/Formable.hs
+++ /dev/null
@@ -1,319 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-module Yesod.Formable
-    ( Form (..)
-    , Formlet
-    , FormResult (..)
-    , runForm
-    , incr
-    , Formable (..)
-    , deriveFormable
-    , share2
-    , wrapperRow
-    , sealFormlet
-    , sealForm
-    , Slug (..)
-    , sealRow
-    , check
-    ) where
-
-import Text.Hamlet
-import Data.Time (Day)
-import Control.Applicative
-import Database.Persist (PersistField)
-import Database.Persist.Helper (EntityDef (..))
-import Data.Char (isAlphaNum, toUpper, isUpper)
-import Language.Haskell.TH.Syntax
-import Control.Monad (liftM, join)
-import Control.Arrow (first)
-import Data.Maybe (fromMaybe, isJust)
-import Data.Monoid (mempty, mappend)
-import qualified Data.ByteString.Lazy.UTF8
-import Yesod.Request
-import Yesod.Handler
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.State
-import Web.Routes.Quasi (Routes, SinglePiece)
-import Data.Int (Int64)
-
-sealRow :: Formable b => String -> (a -> b) -> Maybe a -> Form sub master b
-sealRow label getVal val =
-    sealForm (wrapperRow label) $ formable $ fmap getVal val
-
-runForm :: Form sub y a
-        -> GHandler sub y (FormResult a, Hamlet (Routes y))
-runForm f = do
-    req <- getRequest
-    (pp, _) <- liftIO $ reqRequestBody req
-    evalStateT (deform f pp) 1
-
-type Env = [(String, String)]
-
-type Incr = StateT Int
-
-incr :: Monad m => Incr m Int
-incr = do
-    i <- get
-    let i' = i + 1
-    put i'
-    return i'
-
-data FormResult a = FormMissing
-                  | FormFailure [String]
-                  | FormSuccess a
-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
-
-newtype Form sub y a = Form
-    { deform :: Env -> Incr (GHandler sub y) (FormResult a, Hamlet (Routes y))
-    }
-type Formlet sub y a = Maybe a -> Form sub y a
-
-instance Functor (Form sub url) where
-    fmap f (Form g) = Form $ \env -> liftM (first $ fmap f) (g env)
-
-instance Applicative (Form sub url) where
-    pure a = Form $ const $ return (pure a, mempty)
-    (Form f) <*> (Form g) = Form $ \env -> do
-        (f1, f2) <- f env
-        (g1, g2) <- g env
-        return (f1 <*> g1, f2 `mappend` g2)
-
-sealForm :: ([String] -> Hamlet (Routes y) -> Hamlet (Routes y))
-         -> Form sub y a -> Form sub y a
-sealForm wrapper (Form form) = Form $ \env -> liftM go (form env)
-  where
-    go (res, xml) = (res, wrapper (toList res) xml)
-    toList (FormFailure errs) = errs
-    toList _ = []
-
-sealFormlet :: ([String] -> Hamlet (Routes y) -> Hamlet (Routes y))
-            -> Formlet sub y a -> Formlet sub y a
-sealFormlet wrapper formlet initVal = sealForm wrapper $ formlet initVal
-
-input' :: (String -> String -> Hamlet (Routes y))
-       -> Maybe String
-       -> Form sub y String
-input' mkXml val = Form $ \env -> do
-    i <- incr
-    let i' = show i
-    let param = lookup i' env
-    let xml = mkXml i' $ fromMaybe (fromMaybe "" val) param
-    return (maybe FormMissing FormSuccess param, xml)
-
-check :: Form sub url a -> (a -> Either [String] b) -> Form sub url b
-check (Form form) f = Form $ \env -> liftM (first go) (form env)
-  where
-    go FormMissing = FormMissing
-    go (FormFailure x) = FormFailure x
-    go (FormSuccess a) =
-        case f a of
-            Left errs -> FormFailure errs
-            Right b -> FormSuccess b
-
-class Formable a where
-    formable :: Formlet sub master a
-
-wrapperRow :: String -> [String] -> Hamlet url -> Hamlet url
-wrapperRow label errs control = [$hamlet|
-%tr
-    %th $string.label$
-    %td ^control^
-    $if not.null.errs
-        %td.errors
-            %ul
-                $forall errs err
-                    %li $string.err$
-|]
-
-instance Formable String where
-    formable x = input' go x `check` notEmpty
-      where
-        go name val = [$hamlet|
-%input!type=text!name=$string.name$!value=$string.val$
-|]
-        notEmpty s
-            | null s = Left ["Value required"]
-            | otherwise = Right s
-
-instance Formable (Maybe String) where
-    formable x = input' go (join x) `check` isEmpty
-      where
-        go name val = [$hamlet|
-%input!type=text!name=$string.name$!value=$string.val$
-|]
-        isEmpty s
-            | null s = Right Nothing
-            | otherwise = Right $ Just s
-
-instance Formable (Html ()) where
-    formable = fmap preEscapedString
-              . input' go
-              . fmap (Data.ByteString.Lazy.UTF8.toString . renderHtml)
-      where
-        go name val = [$hamlet|%textarea!name=$string.name$ $string.val$|]
-
-instance Formable Day where
-    formable x = input' go (fmap show x) `check` asDay
-      where
-        go name val = [$hamlet|
-%input!type=date!name=$string.name$!value=$string.val$
-|]
-        asDay s = case reads s of
-                    (y, _):_ -> Right y
-                    [] -> Left ["Invalid day"]
-
-instance Formable Int64 where
-    formable x = input' go (fmap show x) `check` asInt
-      where
-        go name val = [$hamlet|
-%input!type=number!name=$string.name$!value=$string.val$
-|]
-        asInt s = case reads s of
-                    (y, _):_ -> Right y
-                    [] -> Left ["Invalid integer"]
-
-instance Formable Double where
-    formable x = input' go (fmap numstring x) `check` asDouble
-      where
-        go name val = [$hamlet|
-%input!type=number!name=$string.name$!value=$string.val$
-|]
-        asDouble s = case reads s of
-                    (y, _):_ -> Right y
-                    [] -> Left ["Invalid double"]
-        numstring d =
-            let s = show d
-             in case reverse s of
-                    '0':'.':y -> reverse y
-                    _ -> s
-
-instance Formable (Maybe Day) where
-    formable x = input' go (fmap show $ join x) `check` asDay
-      where
-        go name val = [$hamlet|
-%input!type=date!name=$string.name$!value=$string.val$
-|]
-        asDay "" = Right Nothing
-        asDay s = case reads s of
-                    (y, _):_ -> Right $ Just y
-                    [] -> Left ["Invalid day"]
-
-instance Formable (Maybe Int) where
-    formable x = input' go (fmap show $ join x) `check` asInt
-      where
-        go name val = [$hamlet|
-%input!type=number!name=$string.name$!value=$string.val$
-|]
-        asInt "" = Right Nothing
-        asInt s = case reads s of
-                    (y, _):_ -> Right $ Just y
-                    [] -> Left ["Invalid integer"]
-
-instance Formable (Maybe Int64) where
-    formable x = input' go (fmap show $ join x) `check` asInt
-      where
-        go name val = [$hamlet|
-%input!type=number!name=$string.name$!value=$string.val$
-|]
-        asInt "" = Right Nothing
-        asInt s = case reads s of
-                    (y, _):_ -> Right $ Just y
-                    [] -> Left ["Invalid integer"]
-
-instance Formable Bool where
-    formable x = Form $ \env -> do
-        i <- incr
-        let i' = show i
-        let param = lookup i' env
-        let def = if null env then fromMaybe False x else isJust param
-        return (FormSuccess $ isJust param, go i' def)
-      where
-        go name val = [$hamlet|
-%input!type=checkbox!name=$string.name$!:val:checked
-|]
-
-instance Formable Int where
-    formable x = input' go (fmap show x) `check` asInt
-      where
-        go name val = [$hamlet|
-%input!type=number!name=$string.name$!value=$string.val$
-|]
-        asInt s = case reads s of
-                    (y, _):_ -> Right y
-                    [] -> Left ["Invalid integer"]
-
-newtype Slug = Slug { unSlug :: String }
-    deriving (Read, Eq, Show, SinglePiece, PersistField)
-
-instance Formable Slug where
-    formable x = input' go (fmap unSlug x) `check` asSlug
-      where
-        go name val = [$hamlet|
-%input!type=text!name=$string.name$!value=$string.val$
-|]
-        asSlug [] = Left ["Slug must be non-empty"]
-        asSlug x'
-            | all (\c -> c `elem` "-_" || isAlphaNum c) x' =
-                Right $ Slug x'
-            | otherwise = Left ["Slug must be alphanumeric, - and _"]
-
-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'
-
-deriveFormable :: [EntityDef] -> Q [Dec]
-deriveFormable = mapM derive
-  where
-    derive :: EntityDef -> Q Dec
-    derive t = do
-        let fst3 (x, _, _) = x
-        let cols = map (toLabel . fst3) $ entityColumns t
-        ap <- [|(<*>)|]
-        just <- [|pure|]
-        nothing <- [|Nothing|]
-        let just' = just `AppE` ConE (mkName $ entityName t)
-        let c1 = Clause [ ConP (mkName "Nothing") []
-                        ]
-                        (NormalB $ go ap just' $ zip cols $ map (const nothing) cols)
-                        []
-        xs <- mapM (const $ newName "x") cols
-        let xs' = map (AppE just . VarE) xs
-        let c2 = Clause [ ConP (mkName "Just") [ConP (mkName $ entityName t)
-                            $ map VarP xs]]
-                        (NormalB $ go ap just' $ zip cols xs')
-                        []
-        return $ InstanceD [] (ConT ''Formable
-                              `AppT` ConT (mkName $ entityName t))
-            [FunD (mkName "formable") [c1, c2]]
-    go ap just' = foldl (ap' ap) just' . map go'
-    go' (label, ex) =
-        VarE (mkName "sealForm") `AppE`
-        (VarE (mkName "wrapperRow") `AppE` LitE (StringL label)) `AppE`
-        (VarE (mkName "formable") `AppE` ex)
-    ap' ap x y = InfixE (Just x) ap (Just y)
-
-toLabel :: String -> String
-toLabel "" = ""
-toLabel (x:rest) = toUpper x : go rest
-  where
-    go "" = ""
-    go (c:cs)
-        | isUpper c = ' ' : c : go cs
-        | otherwise = c : go cs
diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs
--- a/Yesod/Hamlet.hs
+++ b/Yesod/Hamlet.hs
@@ -17,7 +17,6 @@
 import Text.Hamlet
 import Yesod.Content
 import Yesod.Handler
-import Web.Routes.Quasi (Routes)
 
 -- | Content for a web page. By providing this datatype, we can easily create
 -- generic site templates, which would have the type signature:
@@ -31,11 +30,11 @@
 
 -- | Converts the given Hamlet template into 'Content', which can be used in a
 -- Yesod 'Response'.
-hamletToContent :: Hamlet (Routes master) -> GHandler sub master Content
+hamletToContent :: Hamlet (Route master) -> GHandler sub master Content
 hamletToContent h = do
     render <- getUrlRender
     return $ toContent $ renderHamlet render h
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml :: Hamlet (Routes master) -> GHandler sub master RepHtml
+hamletToRepHtml :: Hamlet (Route master) -> GHandler sub master RepHtml
 hamletToRepHtml = fmap RepHtml . hamletToContent
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Handler
@@ -21,14 +21,16 @@
 --
 ---------------------------------------------------------
 module Yesod.Handler
-    ( -- * Handler monad
-      Handler
+    ( -- * Type families
+      Route
+      -- * Handler monad
+    , Handler
     , GHandler
       -- ** Read information from handler
     , getYesod
     , getYesodSub
     , getUrlRender
-    , getRoute
+    , getCurrentRoute
     , getRouteToMaster
       -- * Special responses
       -- ** Redirecting
@@ -41,16 +43,17 @@
     , badMethod
     , permissionDenied
     , invalidArgs
-      -- ** Sending static files
+      -- ** Short-circuit responses.
     , sendFile
+    , sendResponse
       -- * Setting headers
-    , addCookie
+    , setCookie
     , deleteCookie
-    , header
+    , setHeader
     , setLanguage
       -- * Session
     , setSession
-    , clearSession
+    , deleteSession
       -- ** Ultimate destination
     , setUltDest
     , setUltDestString
@@ -62,14 +65,15 @@
       -- * Internal Yesod
     , runHandler
     , YesodApp (..)
+    , toMasterHandler
     ) where
 
 import Prelude hiding (catch)
 import Yesod.Request
 import Yesod.Content
 import Yesod.Internal
-import Web.Routes.Quasi (Routes)
 import Data.List (foldl', intercalate)
+import Data.Neither
 
 import Control.Exception hiding (Handler, catch)
 import qualified Control.Exception as E
@@ -79,7 +83,7 @@
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Writer
 import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Cont
+import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO)
 
 import System.IO
 import qualified Network.Wai as W
@@ -91,25 +95,53 @@
 import Numeric (showIntAtBase)
 import Data.Char (ord, chr)
 
+-- | The type-safe URLs associated with a site argument.
+type family Route a
+
 data HandlerData sub master = HandlerData
     { handlerRequest :: Request
     , handlerSub :: sub
     , handlerMaster :: master
-    , handlerRoute :: Maybe (Routes sub)
-    , handlerRender :: (Routes master -> String)
-    , handlerToMaster :: Routes sub -> Routes master
+    , handlerRoute :: Maybe (Route sub)
+    , handlerRender :: (Route master -> String)
+    , handlerToMaster :: Route sub -> Route master
     }
 
+handlerSubData :: (Route sub -> Route master)
+               -> (master -> sub)
+               -> Route sub
+               -> HandlerData oldSub master
+               -> HandlerData sub master
+handlerSubData tm ts route hd = hd
+    { handlerSub = ts $ handlerMaster hd
+    , handlerToMaster = tm
+    , handlerRoute = Just route
+    }
+
+-- | Used internally for promoting subsite handler functions to master site
+-- handler functions. Should not be needed by users.
+toMasterHandler :: (Route sub -> Route master)
+                -> (master -> sub)
+                -> Route sub
+                -> GHandler sub master a
+                -> Handler master a
+toMasterHandler tm ts route (GHandler h) =
+    GHandler $ withReaderT (handlerSubData tm ts route) h
+
 -- | A generic handler monad, which can have a different subsite and master
--- site. This monad is a combination of reader for basic arguments, a writer
--- for headers, and an error-type monad for handling special responses.
-type GHandler sub master =
+-- site. This monad is a combination of 'ReaderT' for basic arguments, a
+-- 'WriterT' for headers and session, and an 'MEitherT' monad for handling
+-- special responses. It is declared as a newtype to make compiler errors more
+-- readable.
+newtype GHandler sub master a = GHandler { unGHandler ::
     ReaderT (HandlerData sub master) (
-    ContT HandlerContents (
+    MEitherT HandlerContents (
     WriterT (Endo [Header]) (
     WriterT (Endo [(String, Maybe String)]) (
     IO
-    ))))
+    )))) a
+}
+    deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO)
 
 type Endo a = a -> a
 
@@ -136,31 +168,31 @@
     | HCRedirect RedirectType String
 
 instance Failure ErrorResponse (GHandler sub master) where
-    failure = lift . ContT . const . return . HCError
+    failure = GHandler . lift . throwMEither . HCError
 instance RequestReader (GHandler sub master) where
-    getRequest = handlerRequest <$> ask
+    getRequest = handlerRequest <$> GHandler ask
 
 -- | Get the sub application argument.
 getYesodSub :: GHandler sub master sub
-getYesodSub = handlerSub <$> ask
+getYesodSub = handlerSub <$> GHandler ask
 
 -- | Get the master site appliation argument.
 getYesod :: GHandler sub master master
-getYesod = handlerMaster <$> ask
+getYesod = handlerMaster <$> GHandler ask
 
 -- | Get the URL rendering function.
-getUrlRender :: GHandler sub master (Routes master -> String)
-getUrlRender = handlerRender <$> ask
+getUrlRender :: GHandler sub master (Route master -> String)
+getUrlRender = 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'.
-getRoute :: GHandler sub master (Maybe (Routes sub))
-getRoute = handlerRoute <$> ask
+getCurrentRoute :: GHandler sub master (Maybe (Route sub))
+getCurrentRoute = handlerRoute <$> GHandler ask
 
 -- | Get the function to promote a route for a subsite to a route for the
 -- master site.
-getRouteToMaster :: GHandler sub master (Routes sub -> Routes master)
-getRouteToMaster = handlerToMaster <$> ask
+getRouteToMaster :: GHandler sub master (Route sub -> Route master)
+getRouteToMaster = handlerToMaster <$> GHandler ask
 
 modifySession :: [(String, String)] -> (String, Maybe String)
               -> [(String, String)]
@@ -176,9 +208,9 @@
 -- 'GHandler' into an 'W.Application'. Should not be needed by users.
 runHandler :: HasReps c
            => GHandler sub master c
-           -> (Routes master -> String)
-           -> Maybe (Routes sub)
-           -> (Routes sub -> Routes master)
+           -> (Route master -> String)
+           -> Maybe (Route sub)
+           -> (Route sub -> Route master)
            -> master
            -> (master -> sub)
            -> YesodApp
@@ -194,23 +226,25 @@
             , handlerRender = mrender
             , handlerToMaster = tomr
             }
-    ((contents, headers), session') <- E.catch (
+    ((contents', headers), session') <- E.catch (
         runWriterT
       $ runWriterT
-      $ flip runContT (return . HCContent . chooseRep)
-      $ flip runReaderT hd handler
-        ) (\e -> return ((HCError $ toErrorHandler e, id), id))
+      $ runMEitherT
+      $ flip runReaderT hd
+      $ unGHandler handler
+        ) (\e -> return ((MLeft $ HCError $ toErrorHandler e, id), id))
+    let contents = meither id (HCContent . chooseRep) contents'
     let finalSession = foldl' modifySession (reqSession rr) $ session' []
     let handleError e = do
             (_, hs, ct, c, sess) <- unYesodApp (eh e) safeEh rr cts
             let hs' = headers hs
             return (getStatus e, hs', ct, c, sess)
     let sendFile' ct fp =
-            return (W.Status200, headers [], ct, ContentFile fp, finalSession)
+            return (W.status200, headers [], ct, W.ResponseFile fp, finalSession)
     case contents of
         HCContent a -> do
             (ct, c) <- chooseRep a cts
-            return (W.Status200, headers [], ct, c, finalSession)
+            return (W.status200, headers [], ct, c, finalSession)
         HCError e -> handleError e
         HCRedirect rt loc -> do
             let hs = Header "Location" loc : headers []
@@ -223,20 +257,19 @@
 safeEh :: ErrorResponse -> YesodApp
 safeEh er = YesodApp $ \_ _ _ -> do
     liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
-    return (W.Status500, [], typePlain, toContent "Internal Server Error", [])
+    return (W.status500, [], typePlain, toContent "Internal Server Error", [])
 
 -- | Redirect to the given route.
-redirect :: RedirectType -> Routes master -> GHandler sub master a
-redirect rt url = do
-    r <- getUrlRender
-    redirectString rt $ r url
+redirect :: RedirectType -> Route master -> GHandler sub master a
+redirect rt url = redirectParams rt url []
 
 -- | Redirects to the given route with the associated query-string parameters.
-redirectParams :: RedirectType -> Routes master -> [(String, String)]
+redirectParams :: RedirectType -> Route master -> [(String, String)]
                -> GHandler sub master a
 redirectParams rt url params = do
     r <- getUrlRender
-    redirectString rt $ r url ++ '?' : encodeUrlPairs params
+    redirectString rt $ r url ++
+        if null params then "" else '?' : encodeUrlPairs params
   where
     encodeUrlPairs = intercalate "&" . map encodeUrlPair
     encodeUrlPair (x, []) = escape x
@@ -260,7 +293,7 @@
 
 -- | Redirect to the given URL.
 redirectString :: RedirectType -> String -> GHandler sub master a
-redirectString rt url = lift $ ContT $ const $ return $ HCRedirect rt url
+redirectString rt = GHandler . lift . throwMEither . HCRedirect rt
 
 ultDestKey :: String
 ultDestKey = "_ULT"
@@ -269,7 +302,7 @@
 --
 -- An ultimate destination is stored in the user session and can be loaded
 -- later by 'redirectUltDest'.
-setUltDest :: Routes master -> GHandler sub master ()
+setUltDest :: Route master -> GHandler sub master ()
 setUltDest dest = do
     render <- getUrlRender
     setUltDestString $ render dest
@@ -284,7 +317,7 @@
 -- nothing.
 setUltDest' :: GHandler sub master ()
 setUltDest' = do
-    route <- getRoute
+    route <- getCurrentRoute
     tm <- getRouteToMaster
     maybe (return ()) setUltDest $ tm <$> route
 
@@ -293,11 +326,11 @@
 --
 -- The ultimate destination is set with 'setUltDest'.
 redirectUltDest :: RedirectType
-                -> Routes master -- ^ default destination if nothing in session
+                -> Route master -- ^ default destination if nothing in session
                 -> GHandler sub master ()
 redirectUltDest rt def = do
     mdest <- lookupSession ultDestKey
-    clearSession ultDestKey
+    deleteSession ultDestKey
     maybe (redirect rt def) (redirectString rt) mdest
 
 msgKey :: String
@@ -305,6 +338,9 @@
 
 -- | Sets a message in the user's session.
 --
+-- The message set here will not be visible within the current request;
+-- instead, it will only appear in the next request.
+--
 -- See 'getMessage'.
 setMessage :: Html () -> GHandler sub master ()
 setMessage = setSession msgKey . L.toString . renderHtml
@@ -315,7 +351,7 @@
 -- See 'setMessage'.
 getMessage :: GHandler sub master (Maybe (Html ()))
 getMessage = do
-    clearSession msgKey
+    deleteSession msgKey
     fmap (fmap preEscapedString) $ lookupSession msgKey
 
 -- | Bypass remaining handler code and output the given file.
@@ -323,8 +359,12 @@
 -- For some backends, this is more efficient than reading in the file to
 -- memory, since they can optimize file sending via a system call to sendfile.
 sendFile :: ContentType -> FilePath -> GHandler sub master a
-sendFile ct fp = lift $ ContT $ const $ return $ HCSendFile ct fp
+sendFile ct = GHandler . lift . throwMEither . HCSendFile ct
 
+-- | Bypass remaining handler code and output the given content.
+sendResponse :: HasReps c => c -> GHandler sub master a
+sendResponse = GHandler . lift . throwMEither . HCContent . chooseRep
+
 -- | Return a 404 not found page. Also denotes no handler available.
 notFound :: Failure ErrorResponse m => m a
 notFound = failure NotFound
@@ -333,35 +373,35 @@
 badMethod :: (RequestReader m, Failure ErrorResponse m) => m a
 badMethod = do
     w <- waiRequest
-    failure $ BadMethod $ toString $ W.methodToBS $ W.requestMethod w
+    failure $ BadMethod $ toString $ W.requestMethod w
 
 -- | Return a 403 permission denied page.
-permissionDenied :: Failure ErrorResponse m => m a
-permissionDenied = failure $ PermissionDenied "Permission denied"
+permissionDenied :: Failure ErrorResponse m => String -> m a
+permissionDenied = failure . PermissionDenied
 
 -- | Return a 400 invalid arguments page.
-invalidArgs :: Failure ErrorResponse m => [(ParamName, String)] -> m a
+invalidArgs :: Failure ErrorResponse m => [String] -> m a
 invalidArgs = failure . InvalidArgs
 
 ------- Headers
 -- | Set the cookie on the client.
-addCookie :: Int -- ^ minutes to timeout
+setCookie :: Int -- ^ minutes to timeout
           -> String -- ^ key
           -> String -- ^ value
           -> GHandler sub master ()
-addCookie a b = addHeader . AddCookie a b
+setCookie a b = addHeader . AddCookie a b
 
 -- | Unset the cookie on the client.
 deleteCookie :: String -> GHandler sub master ()
 deleteCookie = addHeader . DeleteCookie
 
--- | Set the language header. Will show up in 'languages'.
+-- | Set the language in the user session. Will show up in 'languages'.
 setLanguage :: String -> GHandler sub master ()
-setLanguage = addCookie 60 langKey
+setLanguage = setSession langKey
 
 -- | Set an arbitrary header on the client.
-header :: String -> String -> GHandler sub master ()
-header a = addHeader . Header a
+setHeader :: String -> String -> GHandler sub master ()
+setHeader a = addHeader . Header a
 
 -- | Set a variable in the user's session.
 --
@@ -371,26 +411,27 @@
 setSession :: String -- ^ key
            -> String -- ^ value
            -> GHandler sub master ()
-setSession k v = lift . lift . lift . tell $ (:) (k, Just v)
+setSession k v = GHandler . lift . lift . lift . tell $ (:) (k, Just v)
 
 -- | Unsets a session variable. See 'setSession'.
-clearSession :: String -> GHandler sub master ()
-clearSession k = lift . lift . lift . tell $ (:) (k, Nothing)
+deleteSession :: String -> GHandler sub master ()
+deleteSession k = GHandler . lift . lift . lift . tell $ (:) (k, Nothing)
 
+-- | Internal use only, not to be confused with 'setHeader'.
 addHeader :: Header -> GHandler sub master ()
-addHeader = lift . lift . tell . (:)
+addHeader = GHandler . lift . lift . tell . (:)
 
 getStatus :: ErrorResponse -> W.Status
-getStatus NotFound = W.Status404
-getStatus (InternalError _) = W.Status500
-getStatus (InvalidArgs _) = W.Status400
-getStatus (PermissionDenied _) = W.Status403
-getStatus (BadMethod _) = W.Status405
+getStatus NotFound = W.status404
+getStatus (InternalError _) = W.status500
+getStatus (InvalidArgs _) = W.status400
+getStatus (PermissionDenied _) = W.status403
+getStatus (BadMethod _) = W.status405
 
 getRedirectStatus :: RedirectType -> W.Status
-getRedirectStatus RedirectPermanent = W.Status301
-getRedirectStatus RedirectTemporary = W.Status302
-getRedirectStatus RedirectSeeOther = W.Status303
+getRedirectStatus RedirectPermanent = W.status301
+getRedirectStatus RedirectTemporary = W.status302
+getRedirectStatus RedirectSeeOther = W.status303
 
 -- | Different types of redirects.
 data RedirectType = RedirectPermanent
diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs
--- a/Yesod/Helpers/AtomFeed.hs
+++ b/Yesod/Helpers/AtomFeed.hs
@@ -29,7 +29,7 @@
 instance HasReps RepAtom where
     chooseRep (RepAtom c) _ = return (typeAtom, c)
 
-atomFeed :: AtomFeed (Routes master) -> GHandler sub master RepAtom
+atomFeed :: AtomFeed (Route master) -> GHandler sub master RepAtom
 atomFeed = fmap RepAtom . hamletToContent . template
 
 data AtomFeed url = AtomFeed
@@ -47,17 +47,14 @@
     , atomEntryContent :: Html ()
     }
 
-xmlns :: AtomFeed url -> Html ()
-xmlns _ = preEscapedString "http://www.w3.org/2005/Atom"
-
 template :: AtomFeed url -> Hamlet url
 template arg = [$xhamlet|
 <?xml version="1.0" encoding="utf-8"?>
-%feed!xmlns=$xmlns.arg$
-    %title $string.atomTitle.arg$
+%feed!xmlns="http://www.w3.org/2005/Atom"
+    %title $atomTitle.arg$
     %link!rel=self!href=@atomLinkSelf.arg@
     %link!href=@atomLinkHome.arg@
-    %updated $string.formatW3.atomUpdated.arg$
+    %updated $formatW3.atomUpdated.arg$
     %id @atomLinkHome.arg@
     $forall atomEntries.arg entry
         ^entryTemplate.entry^
@@ -68,7 +65,7 @@
 %entry
     %id @atomEntryLink.arg@
     %link!href=@atomEntryLink.arg@
-    %updated $string.formatW3.atomEntryUpdated.arg$
-    %title $string.atomEntryTitle.arg$
+    %updated $formatW3.atomEntryUpdated.arg$
+    %title $atomEntryTitle.arg$
     %content!type=html $cdata.atomEntryContent.arg$
 |]
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -22,8 +22,7 @@
 module Yesod.Helpers.Auth
     ( -- * Subsite
       Auth (..)
-    , AuthRoutes (..)
-    , siteAuth
+    , AuthRoute (..)
       -- * Settings
     , YesodAuth (..)
     , Creds (..)
@@ -38,6 +37,7 @@
 
 import qualified Web.Authenticate.Rpxnow as Rpxnow
 import qualified Web.Authenticate.OpenId as OpenId
+import qualified Web.Authenticate.Facebook as Facebook
 
 import Yesod
 
@@ -49,16 +49,17 @@
 import Control.Concurrent.MVar
 import System.IO
 import Control.Monad.Attempt
-import Data.Monoid (mempty)
 import Data.ByteString.Lazy.UTF8 (fromString)
+import Data.Object
 
+-- | Minimal complete definition: 'defaultDest' and 'defaultLoginRoute'.
 class Yesod master => YesodAuth master where
     -- | Default destination on successful login or logout, if no other
     -- destination exists.
-    defaultDest :: master -> Routes master
+    defaultDest :: master -> Route master
 
     -- | Default page to redirect user to for logging in.
-    defaultLoginRoute :: master -> Routes master
+    defaultLoginRoute :: master -> Route master
 
     -- | Callback for a successful login.
     --
@@ -75,17 +76,19 @@
         stdgen <- newStdGen
         return $ take 10 $ randomRs ('A', 'Z') stdgen
 
--- | Each authentication subsystem (OpenId, Rpxnow, Email) has its own
--- settings. If those settings are not present, then relevant handlers will
+-- | 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
+    -- | client id, secret and requested permissions
+    , authFacebook :: Maybe (String, String, [String])
     }
 
 -- | Which subsystem authenticated the user.
-data AuthType = AuthOpenId | AuthRpxnow | AuthEmail
+data AuthType = AuthOpenId | AuthRpxnow | AuthEmail | AuthFacebook
     deriving (Show, Read, Eq)
 
 type Email = String
@@ -117,6 +120,7 @@
     , credsEmail :: Maybe String -- ^ Verified e-mail address.
     , credsDisplayName :: Maybe String -- ^ Display name.
     , credsId :: Maybe Integer -- ^ Numeric ID, if used.
+    , credsFacebookToken :: Maybe Facebook.AccessToken
     }
     deriving (Show, Read, Eq)
 
@@ -147,8 +151,11 @@
 /openid/complete         OpenIdComplete     GET
 /login/rpxnow            RpxnowR
 
+/facebook                FacebookR          GET
+/facebook/start          StartFacebookR     GET
+
 /register                EmailRegisterR     GET POST
-/verify/#EmailId/#String EmailVerifyR       GET
+/verify/#Integer/#String EmailVerifyR       GET
 /login                   EmailLoginR        GET POST
 /set-password            EmailPasswordR     GET POST
 |]
@@ -161,17 +168,14 @@
 getOpenIdR :: Yesod master => GHandler Auth master RepHtml
 getOpenIdR = do
     testOpenId
-    rr <- getRequest
-    case getParams rr "dest" of
-        [] -> return ()
-        (x:_) -> setUltDestString x
+    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: 
+    %label!for=openid OpenID: $
     %input#openid!type=text!name=openid
     %input!type=submit!value=Login
 |]
@@ -179,10 +183,7 @@
 getOpenIdForward :: GHandler Auth master ()
 getOpenIdForward = do
     testOpenId
-    rr <- getRequest
-    oid <- case getParams rr "openid" of
-            [x] -> return x
-            _ -> invalidArgs [("openid", "Expected single parameter")]
+    oid <- runFormGet' $ stringInput "openid"
     render <- getUrlRender
     toMaster <- getRouteToMaster
     let complete = render $ toMaster OpenIdComplete
@@ -206,7 +207,7 @@
         redirect RedirectTemporary $ toMaster OpenIdR
     let onSuccess (OpenId.Identifier ident) = do
         y <- getYesod
-        setCreds (Creds ident AuthOpenId Nothing Nothing Nothing) []
+        setCreds (Creds ident AuthOpenId Nothing Nothing Nothing Nothing) []
         redirectUltDest RedirectTemporary $ defaultDest y
     attempt onFailure onSuccess res
 
@@ -217,11 +218,11 @@
     apiKey <- case authRpxnowApiKey auth of
                 Just x -> return x
                 Nothing -> notFound
-    rr <- getRequest
-    pp <- postParams rr
-    let token = case getParams rr "token" ++ pp "token" of
-                    [] -> invalidArgs [("token", "Value not supplied")]
-                    (x:_) -> x
+    token1 <- lookupGetParam "token"
+    token2 <- lookupPostParam "token"
+    let token = case token1 `mplus` token2 of
+                    Nothing -> invalidArgs ["token: Value not supplied"]
+                    Just x -> x
     Rpxnow.Identifier ident extra <- liftIO $ Rpxnow.authenticate apiKey token
     let creds = Creds
                     ident
@@ -229,15 +230,16 @@
                     (lookup "verifiedEmail" extra)
                     (getDisplayName extra)
                     Nothing
+                    Nothing
     setCreds creds extra
+    dest1 <- lookupPostParam "dest"
+    dest2 <- lookupGetParam "dest"
     either (redirect RedirectTemporary) (redirectString RedirectTemporary) $
-        case pp "dest" of
-            (d:_) -> Right d
-            [] -> case getParams rr "dest" of
-                    [] -> Left $ defaultDest ay
-                    ("":_) -> Left $ defaultDest ay
-                    (('#':rest):_) -> Right rest
-                    (s:_) -> Right s
+        case dest1 `mplus` dest2 of
+            Just "" -> Left $ defaultDest ay
+            Nothing -> Left $ defaultDest ay
+            Just ('#':d) -> Right d
+            Just d -> Right d
 
 -- | Get some form of a display name.
 getDisplayName :: [(String, String)] -> Maybe String
@@ -256,7 +258,7 @@
 $if isNothing.creds
     %p Not logged in
 $maybe creds c
-    %p Logged in as $string.credsIdent.c$
+    %p Logged in as $credsIdent.c$
 |]
     json creds =
         jsonMap
@@ -268,7 +270,7 @@
 getLogout :: YesodAuth master => GHandler Auth master ()
 getLogout = do
     y <- getYesod
-    clearSession credsKey
+    deleteSession credsKey
     redirectUltDest RedirectTemporary $ defaultDest y
 
 -- | Retrieve user credentials. If user is not logged in, redirects to the
@@ -301,7 +303,7 @@
 postEmailRegisterR :: YesodAuth master => GHandler Auth master RepHtml
 postEmailRegisterR = do
     ae <- getAuthEmailSettings
-    email <- runFormPost $ notEmpty $ required $ input "email" -- FIXME checkEmail
+    email <- runFormPost' $ emailInput "email"
     y <- getYesod
     mecreds <- liftIO $ getEmailCreds ae email
     (lid, verKey) <-
@@ -316,7 +318,7 @@
     let verUrl = render $ tm $ EmailVerifyR lid verKey
     liftIO $ sendVerifyEmail ae email verKey verUrl
     applyLayout "Confirmation e-mail sent" mempty [$hamlet|
-%p A confirmation e-mail has been sent to $string.email$.
+%p A confirmation e-mail has been sent to $email$.
 |]
 
 getEmailVerifyR :: YesodAuth master
@@ -328,12 +330,13 @@
     case (realKey == Just key, memail) of
         (True, Just email) -> do
             liftIO $ verifyAccount ae lid
-            setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)) []
+            setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)
+                      Nothing) []
             toMaster <- getRouteToMaster
             redirect RedirectTemporary $ toMaster EmailPasswordR
         _ -> applyLayout "Invalid verification key" mempty [$hamlet|
 %p I'm sorry, but that was an invalid verification key.
-        |]
+|]
 
 getEmailLoginR :: Yesod master => GHandler Auth master RepHtml
 getEmailLoginR = do
@@ -364,9 +367,9 @@
 postEmailLoginR :: YesodAuth master => GHandler Auth master ()
 postEmailLoginR = do
     ae <- getAuthEmailSettings
-    (email, pass) <- runFormPost $ (,)
-        <$> notEmpty (required $ input "email") -- FIXME valid e-mail?
-        <*> required (input "password")
+    (email, pass) <- runFormPost' $ (,)
+        <$> emailInput "email"
+        <*> stringInput "password"
     y <- getYesod
     mecreds <- liftIO $ getEmailCreds ae email
     let mlid =
@@ -376,7 +379,8 @@
                 _ -> Nothing
     case mlid of
         Just lid -> do
-            setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)) []
+            setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)
+                      Nothing) []
             redirectUltDest RedirectTemporary $ defaultDest y
         Nothing -> do
             setMessage $ string "Invalid email/password combination"
@@ -389,7 +393,7 @@
     toMaster <- getRouteToMaster
     mcreds <- maybeCreds
     case mcreds of
-        Just (Creds _ AuthEmail _ _ (Just _)) -> return ()
+        Just (Creds _ AuthEmail _ _ (Just _) _) -> return ()
         _ -> do
             setMessage $ string "You must be logged in to set a password"
             redirect RedirectTemporary $ toMaster EmailLoginR
@@ -416,16 +420,16 @@
 postEmailPasswordR :: YesodAuth master => GHandler Auth master ()
 postEmailPasswordR = do
     ae <- getAuthEmailSettings
-    (new, confirm) <- runFormPost $ (,)
-        <$> notEmpty (required $ input "new")
-        <*> notEmpty (required $ input "confirm")
+    (new, confirm) <- runFormPost' $ (,)
+        <$> stringInput "new"
+        <*> stringInput "confirm"
     toMaster <- getRouteToMaster
     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
+            Just (Creds _ AuthEmail _ _ (Just lid) _) -> return lid
             _ -> do
                 setMessage $ string "You must be logged in to set a password"
                 redirect RedirectTemporary $ toMaster EmailLoginR
@@ -453,6 +457,9 @@
 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 []
@@ -481,3 +488,38 @@
     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
+    case a of
+        Nothing -> notFound
+        Just (cid, secret, _) -> do
+            render <- getUrlRender
+            tm <- getRouteToMaster
+            let fb = Facebook.Facebook cid secret $ render $ tm FacebookR
+            code <- runFormGet' $ stringInput "code"
+            at <- liftIO $ Facebook.getAccessToken fb code
+            so <- liftIO $ Facebook.getGraphData at "me"
+            let c = fromMaybe (error "Invalid response from Facebook") $ do
+                m <- fromMapping so
+                id' <- lookupScalar "id" m
+                let name = lookupScalar "name" m
+                let email = lookupScalar "email" m
+                let id'' = "http://graph.facebook.com/" ++ id'
+                return $ Creds id'' AuthFacebook email name Nothing $ Just at
+            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
diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs
--- a/Yesod/Helpers/Crud.hs
+++ b/Yesod/Helpers/Crud.hs
@@ -1,25 +1,32 @@
 {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Rank2Types #-}
 module Yesod.Helpers.Crud
     ( Item (..)
     , Crud (..)
-    , CrudRoutes (..)
+    , CrudRoute (..)
     , defaultCrud
-    , siteCrud
     ) where
 
 import Yesod.Yesod
+import Yesod.Widget
 import Yesod.Dispatch
 import Yesod.Content
 import Yesod.Handler
 import Text.Hamlet
-import Yesod.Formable
+import Yesod.Form
 import Data.Monoid (mempty)
 
-class Formable a => Item a where
+-- | An entity which can be displayed by the Crud subsite.
+class ToForm a => Item a where
+    -- | The title of an entity, to be displayed in the list of all entities.
     itemTitle :: a -> String
 
+-- | Defines all of the CRUD operations (Create, Read, Update, Delete)
+-- necessary to implement this subsite. When using the "Yesod.Form" module and
+-- 'ToForm' typeclass, you can probably just use 'defaultCrud'.
 data Crud master item = Crud
     { crudSelect :: GHandler (Crud master item) master [(Key item, item)]
     , crudReplace :: Key item -> item -> GHandler (Crud master item) master ()
@@ -50,7 +57,7 @@
     $forall items item
         %li
             %a!href=@toMaster.CrudEditR.toSinglePiece.fst.item@
-                $string.itemTitle.snd.item$
+                $itemTitle.snd.item$
 %p
     %a!href=@toMaster.CrudAddR@ Add new item
 |]
@@ -101,10 +108,10 @@
     applyLayout "Confirm delete" mempty [$hamlet|
 %form!method=post!action=@toMaster.CrudDeleteR.s@
     %h1 Really delete?
-    %p Do you really want to delete $string.itemTitle.item$?
+    %p Do you really want to delete $itemTitle.item$?
     %p
         %input!type=submit!value=Yes
-        \ 
+        \ $
         %a!href=@toMaster.CrudListR@ No
 |]
 
@@ -126,7 +133,7 @@
     -> GHandler (Crud master a) master RepHtml
 crudHelper title me isPost = do
     crud <- getYesodSub
-    (errs, form) <- runForm $ formable $ fmap snd me
+    (errs, form, enctype) <- runFormPost $ toForm $ fmap snd me
     toMaster <- getRouteToMaster
     case (isPost, errs) of
         (True, FormSuccess a) -> do
@@ -138,23 +145,30 @@
             redirect RedirectTemporary $ toMaster $ CrudEditR
                                        $ toSinglePiece eid
         _ -> return ()
-    applyLayout title mempty [$hamlet|
+    applyLayoutW $ do
+        wrapWidget form (wrapForm toMaster enctype)
+        setTitle $ string title
+  where
+    wrapForm toMaster enctype form = [$hamlet|
 %p
     %a!href=@toMaster.CrudListR@ Return to list
-%h1 $string.title$
-%form!method=post
+%h1 $title$
+%form!method=post!enctype=$show.enctype$
     %table
         ^form^
         %tr
             %td!colspan=2
                 %input!type=submit
                 $maybe me e
-                    \ 
+                    \ $
                     %a!href=@toMaster.CrudDeleteR.toSinglePiece.fst.e@ Delete
 |]
 
-defaultCrud :: (PersistEntity i, YesodPersist a, PersistMonad i ~ YesodDB a)
-            => a -> Crud a i
+-- | A default 'Crud' value which relies about persistent and "Yesod.Form".
+defaultCrud
+    :: (PersistEntity i, PersistBackend (YesodDB a (GHandler (Crud a i) a)),
+        YesodPersist a)
+    => a -> Crud a i
 defaultCrud = const Crud
     { crudSelect = runDB $ select [] []
     , crudReplace = \a -> runDB . replace a
diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs
--- a/Yesod/Helpers/Sitemap.hs
+++ b/Yesod/Helpers/Sitemap.hs
@@ -50,25 +50,22 @@
     , priority :: Double
     }
 
-sitemapNS :: Html ()
-sitemapNS = string "http://www.sitemaps.org/schemas/sitemap/0.9"
-
 template :: [SitemapUrl url] -> Hamlet url
 template urls = [$hamlet|
-%urlset!xmlns=$sitemapNS$
+%urlset!xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"
     $forall urls url
         %url
             %loc @sitemapLoc.url@
-            %lastmod $string.formatW3.sitemapLastMod.url$
-            %changefreq $string.showFreq.sitemapChangeFreq.url$
-            %priority $string.show.priority.url$
+            %lastmod $formatW3.sitemapLastMod.url$
+            %changefreq $showFreq.sitemapChangeFreq.url$
+            %priority $show.priority.url$
 |]
 
-sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml
+sitemap :: [SitemapUrl (Route master)] -> GHandler sub master RepXml
 sitemap = fmap RepXml . hamletToContent . template
 
 -- | A basic robots file which just lists the "Sitemap: " line.
-robots :: Routes sub -- ^ sitemap url
+robots :: Route sub -- ^ sitemap url
        -> GHandler sub master RepPlain
 robots smurl = do
     tm <- getRouteToMaster
diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Helpers.Static
@@ -25,8 +27,7 @@
 module Yesod.Helpers.Static
     ( -- * Subsite
       Static (..)
-    , StaticRoutes (..)
-    , siteStatic
+    , StaticRoute (..)
       -- * Lookup files in filesystem
     , fileLookupDir
     , staticFiles
@@ -37,6 +38,7 @@
 
 import System.Directory
 import Control.Monad
+import Data.Maybe (fromMaybe)
 
 import Yesod
 import Data.List (intercalate)
@@ -50,11 +52,15 @@
 
 -- | A function for looking up file contents. For serving from the file system,
 -- see 'fileLookupDir'.
-data Static = Static (FilePath -> IO (Maybe (Either FilePath Content)))
+data Static = Static
+    { staticLookup :: FilePath -> IO (Maybe (Either FilePath Content))
+    -- | Mapping from file extension to content type. See 'typeByExt'.
+    , staticTypes :: [(String, ContentType)]
+    }
 
-$(mkYesodSub "Static" [] [$parseRoutes|
+mkYesodSub "Static" [] [$parseRoutes|
 *Strings StaticRoute GET
-|])
+|]
 
 -- | Lookup files in a specific directory.
 --
@@ -62,7 +68,9 @@
 -- probably are), the handler itself checks that no unsafe paths are being
 -- requested. In particular, no path segments may begin with a single period,
 -- so hidden files and parent directories are safe.
-fileLookupDir :: FilePath -> Static
+--
+-- For the second argument to this function, you can just use 'typeByExt'.
+fileLookupDir :: FilePath -> [(String, ContentType)] -> Static
 fileLookupDir dir = Static $ \fp -> do
     let fp' = dir ++ '/' : fp
     exists <- doesFileExist fp'
@@ -71,16 +79,20 @@
         else return Nothing
 
 getStaticRoute :: [String]
-               -> GHandler Static master [(ContentType, Content)]
+               -> GHandler Static master (ContentType, Content)
 getStaticRoute fp' = do
-    Static fl <- getYesodSub
+    Static fl ctypes <- getYesodSub
     when (any isUnsafe fp') notFound
     let fp = intercalate "/" fp'
     content <- liftIO $ fl fp
     case content of
         Nothing -> notFound
-        Just (Left fp'') -> sendFile (typeByExt $ ext fp'') fp''
-        Just (Right bs) -> return [(typeByExt $ ext fp, bs)]
+        Just (Left fp'') -> do
+            let ctype = fromMaybe typeOctet $ lookup (ext fp'') ctypes
+            sendFile ctype fp''
+        Just (Right bs) -> do
+            let ctype = fromMaybe typeOctet $ lookup (ext fp) ctypes
+            return (ctype, bs)
   where
     isUnsafe [] = True
     isUnsafe ('.':_) = True
@@ -104,6 +116,10 @@
         dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
         return $ concat $ files' : dirs'
 
+-- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create:
+--
+-- > style_css = StaticRoute ["style.css"]
+-- > js_script_js = StaticRoute ["js/script.js"]
 staticFiles :: FilePath -> Q [Dec]
 staticFiles fp = do
     fs <- qRunIO $ getFileList fp
@@ -117,7 +133,7 @@
         f' <- lift f
         let sr = ConE $ mkName "StaticRoute"
         return
-            [ SigD name $ ConT ''StaticRoutes
+            [ SigD name $ ConT ''Route `AppT` ConT ''Static
             , FunD name
                 [ Clause [] (NormalB $ sr `AppE` f') []
                 ]
diff --git a/Yesod/Internal.hs b/Yesod/Internal.hs
--- a/Yesod/Internal.hs
+++ b/Yesod/Internal.hs
@@ -13,7 +13,7 @@
 data ErrorResponse =
       NotFound
     | InternalError String
-    | InvalidArgs [(String, String)]
+    | InvalidArgs [String]
     | PermissionDenied String
     | BadMethod String
     deriving (Show, Eq)
diff --git a/Yesod/Json.hs b/Yesod/Json.hs
--- a/Yesod/Json.hs
+++ b/Yesod/Json.hs
@@ -10,6 +10,7 @@
     , jsonScalar
     , jsonList
     , jsonMap
+    , jsonRaw
 #if TEST
     , testSuite
 #endif
@@ -35,8 +36,8 @@
 #endif
 
 -- | A monad for generating Json output. In truth, it is just a newtype wrapper
--- around 'Hamlet'; we thereby get the benefits of Hamlet (interleaving IO and
--- enumerator output) without accidently mixing non-JSON content.
+-- around 'Html'; we thereby get the benefits of BlazeHtml (type safety and
+-- speed) without accidently mixing non-JSON content.
 --
 -- 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
@@ -113,6 +114,12 @@
         , Json $ preEscapedString ":"
         , v
         ]
+
+-- | Outputs raw JSON data without performing any escaping. Use with caution:
+-- 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
 
 #if TEST
 
diff --git a/Yesod/Request.hs b/Yesod/Request.hs
--- a/Yesod/Request.hs
+++ b/Yesod/Request.hs
@@ -29,11 +29,13 @@
     , lookupPostParam
     , lookupCookie
     , lookupSession
-      -- ** Alternate
-    , getParams
-    , postParams
-    , cookies
-    , session
+    , lookupFile
+      -- ** Multi-lookup
+    , lookupGetParams
+    , lookupPostParams
+    , lookupCookies
+    , lookupSessions
+    , lookupFiles
       -- * Parameter type synonyms
     , ParamName
     , ParamValue
@@ -44,8 +46,8 @@
 import qualified Data.ByteString.Lazy as BL
 import "transformers" Control.Monad.IO.Class
 import Control.Monad (liftM)
-import Network.Wai.Parse
 import Control.Monad.Instances () -- I'm missing the instance Monad ((->) r
+import Data.Maybe (listToMaybe)
 
 type ParamName = String
 type ParamValue = String
@@ -60,12 +62,14 @@
 -- | Get the list of supported languages supplied by the user.
 --
 -- Languages are determined based on the following three (in descending order
--- of preference:
+-- of preference):
 --
 -- * The _LANG get parameter.
 --
 -- * The _LANG cookie.
 --
+-- * The _LANG user session variable.
+--
 -- * Accept-Language HTTP header.
 --
 -- This is handled by the parseWaiRequest function in Yesod.Dispatch (not
@@ -80,9 +84,16 @@
 -- | A tuple containing both the POST parameters and submitted files.
 type RequestBodyContents =
     ( [(ParamName, ParamValue)]
-    , [(ParamName, FileInfo BL.ByteString)]
+    , [(ParamName, FileInfo)]
     )
 
+data FileInfo = FileInfo
+    { fileName :: String
+    , fileContentType :: String
+    , fileContent :: BL.ByteString
+    }
+    deriving (Eq, Show)
+
 -- | The parsed request information.
 data Request = Request
     { reqGetParams :: [(ParamName, ParamValue)]
@@ -99,59 +110,64 @@
     , reqLangs :: [String]
     }
 
-multiLookup :: [(ParamName, ParamValue)] -> ParamName -> [ParamValue]
-multiLookup [] _ = []
-multiLookup ((k, v):rest) pn
-    | k == pn = v : multiLookup rest pn
-    | otherwise = multiLookup rest pn
+lookup' :: Eq a => a -> [(a, b)] -> [b]
+lookup' a = map snd . filter (\x -> a == fst x)
 
--- | All GET paramater values with the given name.
-getParams :: RequestReader m => m (ParamName -> [ParamValue])
-getParams = do
+-- | Lookup for GET parameters.
+lookupGetParams :: RequestReader m => ParamName -> m [ParamValue]
+lookupGetParams pn = do
     rr <- getRequest
-    return $ multiLookup $ reqGetParams rr
+    return $ lookup' pn $ reqGetParams rr
 
 -- | Lookup for GET parameters.
 lookupGetParam :: RequestReader m => ParamName -> m (Maybe ParamValue)
-lookupGetParam pn = do
-    rr <- getRequest
-    return $ lookup pn $ reqGetParams rr
+lookupGetParam = liftM listToMaybe . lookupGetParams
 
--- | All POST paramater values with the given name.
-postParams :: MonadIO m => Request -> m (ParamName -> [ParamValue])
-postParams rr = do
+-- | Lookup for POST parameters.
+lookupPostParams :: (MonadIO m, RequestReader m)
+                 => ParamName
+                 -> m [ParamValue]
+lookupPostParams pn = do
+    rr <- getRequest
     (pp, _) <- liftIO $ reqRequestBody rr
-    return $ multiLookup pp
+    return $ lookup' pn pp
 
--- | Lookup for POST parameters.
 lookupPostParam :: (MonadIO m, RequestReader m)
                 => ParamName
                 -> m (Maybe ParamValue)
-lookupPostParam pn = do
-    rr <- getRequest
-    (pp, _) <- liftIO $ reqRequestBody rr
-    return $ lookup pn pp
+lookupPostParam = liftM listToMaybe . lookupPostParams
 
--- | All cookies with the given name.
-cookies :: RequestReader m => m (ParamName -> [ParamValue])
-cookies = do
+-- | Lookup for POSTed files.
+lookupFile :: (MonadIO m, RequestReader m)
+           => ParamName
+           -> m (Maybe FileInfo)
+lookupFile = liftM listToMaybe . lookupFiles
+
+-- | Lookup for POSTed files.
+lookupFiles :: (MonadIO m, RequestReader m)
+            => ParamName
+            -> m [FileInfo]
+lookupFiles pn = do
     rr <- getRequest
-    return $ multiLookup $ reqCookies rr
+    (_, files) <- liftIO $ reqRequestBody rr
+    return $ lookup' pn files
 
 -- | Lookup for cookie data.
 lookupCookie :: RequestReader m => ParamName -> m (Maybe ParamValue)
-lookupCookie pn = do
-    rr <- getRequest
-    return $ lookup pn $ reqCookies rr
+lookupCookie = liftM listToMaybe . lookupCookies
 
--- | All session data with the given name.
-session :: RequestReader m => m (ParamName -> [ParamValue])
-session = do
+-- | Lookup for cookie data.
+lookupCookies :: RequestReader m => ParamName -> m [ParamValue]
+lookupCookies pn = do
     rr <- getRequest
-    return $ multiLookup $ reqSession rr
+    return $ lookup' pn $ reqCookies rr
 
 -- | Lookup for session data.
 lookupSession :: RequestReader m => ParamName -> m (Maybe ParamValue)
-lookupSession pn = do
+lookupSession = liftM listToMaybe . lookupSessions
+
+-- | Lookup for session data.
+lookupSessions :: RequestReader m => ParamName -> m [ParamValue]
+lookupSessions pn = do
     rr <- getRequest
-    return $ lookup pn $ reqSession rr
+    return $ lookup' pn $ reqSession rr
diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Widget.hs
@@ -0,0 +1,215 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE FlexibleInstances #-}
+-- | Widgets combine HTML with JS and CSS dependencies with a unique identifier
+-- generator, allowing you to create truly modular HTML components.
+module Yesod.Widget
+    ( -- * Datatype
+      GWidget
+    , Widget
+      -- * Unwrapping
+    , widgetToPageContent
+    , applyLayoutW
+      -- * Creating
+    , newIdent
+    , setTitle
+    , addStyle
+    , addStylesheet
+    , addStylesheetRemote
+    , addScript
+    , addScriptRemote
+    , addHead
+    , addBody
+    , 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 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
+
+-- | A generic widget, allowing specification of both the subsite and master
+-- site datatypes. This is basically a large 'WriterT' stack keeping track of
+-- dependencies along with a 'StateT' to track unique identifiers.
+newtype GWidget sub master a = GWidget (
+    WriterT (Body (Route master)) (
+    WriterT (Last Title) (
+    WriterT (UniqueList (Script (Route master))) (
+    WriterT (UniqueList (Stylesheet (Route master))) (
+    WriterT (Style (Route master)) (
+    WriterT (JavaScript (Route master)) (
+    WriterT (Head (Route master)) (
+    StateT Int (
+    GHandler sub master
+    )))))))) a)
+    deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO)
+instance Monoid (GWidget sub master ()) where
+    mempty = return ()
+    mappend x y = x >> y
+-- | A 'GWidget' specialized to when the subsite and master site are the same.
+type Widget y = GWidget y y
+
+-- | Set the page title. Calling 'setTitle' multiple times overrides previously
+-- set values.
+setTitle :: Html () -> GWidget sub master ()
+setTitle = GWidget . lift . tell . Last . Just . Title
+
+-- | Add some raw HTML to the head tag.
+addHead :: Hamlet (Route master) -> GWidget sub master ()
+addHead = GWidget . lift . lift . lift . lift . lift . lift . tell . Head
+
+-- | Add some raw HTML to the body tag.
+addBody :: Hamlet (Route master) -> GWidget sub master ()
+addBody = GWidget . tell . Body
+
+-- | Get a unique identifier.
+newIdent :: GWidget sub master String
+newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift $ do
+    i <- get
+    let i' = i + 1
+    put i'
+    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
+
+-- | Link to the specified local stylesheet.
+addStylesheet :: Route master -> GWidget sub master ()
+addStylesheet = GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Local
+
+-- | Link to the specified remote stylesheet.
+addStylesheetRemote :: String -> GWidget sub master ()
+addStylesheetRemote =
+    GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Remote
+
+-- | Link to the specified local script.
+addScript :: Route master -> GWidget sub master ()
+addScript = GWidget . lift . lift . tell . toUnique . Script . Local
+
+-- | Link to the specified remote script.
+addScriptRemote :: String -> GWidget sub master ()
+addScriptRemote =
+    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
+
+-- | Modify the given 'GWidget' by wrapping the body tag HTML code with the
+-- given function. You might also consider using 'extractBody'.
+wrapWidget :: GWidget s m a
+           -> (Hamlet (Route m) -> Hamlet (Route m))
+           -> GWidget s m a
+wrapWidget (GWidget w) wrap =
+    GWidget $ mapWriterT (fmap go) w
+  where
+    go (a, Body h) = (a, Body $ wrap h)
+
+-- | Pull out the HTML tag contents and return it. Useful for performing some
+-- manipulations. It can be easier to use this sometimes than 'wrapWidget'.
+extractBody :: GWidget s m () -> GWidget s m (Hamlet (Route m))
+extractBody (GWidget w) =
+    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
@@ -1,22 +1,29 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 -- | The basic typeclass for a Yesod application.
 module Yesod.Yesod
     ( -- * Type classes
       Yesod (..)
     , YesodSite (..)
+    , YesodSubSite (..)
       -- ** Persistence
     , YesodPersist (..)
-    , PersistEntity (..)
+    , module Database.Persist
+    , get404
       -- ** Breadcrumbs
     , YesodBreadcrumbs (..)
     , breadcrumbs
       -- * Convenience functions
     , applyLayout
     , applyLayoutJson
+    , maybeAuthorized
       -- * Defaults
     , defaultErrorHandler
+      -- * Data types
+    , AuthResult (..)
     ) where
 
 import Yesod.Content
@@ -30,18 +37,25 @@
 import qualified Web.ClientSession as CS
 import Data.Monoid (mempty)
 import Data.ByteString.UTF8 (toString)
-import Database.Persist (PersistEntity (..))
-
-import Web.Routes.Quasi (QuasiSite (..), Routes)
+import Database.Persist
+import Web.Routes.Site (Site)
+import Control.Monad.Trans.Class (MonadTrans (..))
+import Control.Monad.Attempt (Failure)
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
-class YesodSite y where
-    getSite :: QuasiSite YesodApp y y
+class Eq (Route y) => YesodSite y where
+    getSite :: Site (Route y) (Method -> Maybe (Handler y ChooseRep))
+type Method = String
 
+-- | Same as 'YesodSite', but for subsites. Once again, users should not need
+-- to deal with it directly, as the mkYesodSub creates instances appropriately.
+class Eq (Route s) => YesodSubSite s y where
+    getSubSite :: Site (Route s) (Method -> Maybe (GHandler s y ChooseRep))
+
 -- | Define settings for a Yesod applications. The only required setting is
 -- 'approot'; other than that, there are intelligent defaults.
-class Yesod a where
+class Eq (Route a) => Yesod a where
     -- | An absolute URL to the root of the application. Do not include
     -- trailing slash.
     --
@@ -64,14 +78,11 @@
     clientSessionDuration = const 120
 
     -- | Output error response pages.
-    errorHandler :: Yesod y
-                 => a
-                 -> ErrorResponse
-                 -> Handler y ChooseRep
-    errorHandler _ = defaultErrorHandler
+    errorHandler :: ErrorResponse -> GHandler sub a ChooseRep
+    errorHandler = defaultErrorHandler
 
     -- | Applies some form of layout to the contents of a page.
-    defaultLayout :: PageContent (Routes a) -> GHandler sub a Content
+    defaultLayout :: PageContent (Route a) -> GHandler sub a Content
     defaultLayout p = hamletToContent [$hamlet|
 !!!
 %html
@@ -83,36 +94,48 @@
 |]
 
     -- | Gets called at the beginning of each request. Useful for logging.
-    onRequest :: a -> Request -> IO ()
-    onRequest _ _ = return ()
+    onRequest :: GHandler sub a ()
+    onRequest = return ()
 
     -- | Override the rendering function for a particular URL. One use case for
     -- this is to offload static hosting to a different domain name to avoid
     -- sending cookies.
-    urlRenderOverride :: a -> Routes a -> Maybe String
+    urlRenderOverride :: a -> Route a -> Maybe String
     urlRenderOverride _ _ = Nothing
 
-    -- | Determine is a request is authorized or not.
+    -- | Determine if a request is authorized or not.
     --
     -- 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 :: a -> Routes a -> IO (Maybe String)
-    isAuthorized _ _ = return Nothing
+    isAuthorized :: Route a -> GHandler s a AuthResult
+    isAuthorized _ = return Authorized
 
+    -- | The default route for authentication.
+    --
+    -- Used in particular by 'isAuthorized', but library users can do whatever
+    -- they want with it.
+    authRoute :: a -> Maybe (Route a)
+    authRoute _ = Nothing
+
+data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
+    deriving (Eq, Show, Read)
+
 -- | A type-safe, concise method of creating breadcrumbs for pages. For each
 -- resource, you declare the title of the page and the parent resource (if
 -- present).
 class YesodBreadcrumbs y where
     -- | Returns the title and the parent resource, if available. If you return
     -- a 'Nothing', then this is considered a top-level page.
-    breadcrumb :: Routes y -> Handler y (String, Maybe (Routes y))
+    breadcrumb :: Route y -> GHandler sub y (String, Maybe (Route y))
 
 -- | Gets the title of the current page and the hierarchy of parent pages,
 -- along with their respective titles.
-breadcrumbs :: YesodBreadcrumbs y => Handler y (String, [(Routes y, String)])
+breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (String, [(Route y, String)])
 breadcrumbs = do
-    x <- getRoute
+    x' <- getCurrentRoute
+    tm <- getRouteToMaster
+    let x = fmap tm x'
     case x of
         Nothing -> return ("Not found", [])
         Just y -> do
@@ -128,8 +151,8 @@
 -- | Apply the default layout ('defaultLayout') to the given title and body.
 applyLayout :: Yesod master
             => String -- ^ title
-            -> Hamlet (Routes master) -- ^ head
-            -> Hamlet (Routes master) -- ^ body
+            -> Hamlet (Route master) -- ^ head
+            -> Hamlet (Route master) -- ^ body
             -> GHandler sub master RepHtml
 applyLayout t h b =
     RepHtml `fmap` defaultLayout PageContent
@@ -142,8 +165,8 @@
 -- the default layout for the HTML output ('defaultLayout').
 applyLayoutJson :: Yesod master
                 => String -- ^ title
-                -> Hamlet (Routes master) -- ^ head
-                -> Hamlet (Routes master) -- ^ body
+                -> Hamlet (Route master) -- ^ head
+                -> Hamlet (Route master) -- ^ body
                 -> Json
                 -> GHandler sub master RepHtmlJson
 applyLayoutJson t h html json = do
@@ -157,46 +180,63 @@
 
 applyLayout' :: Yesod master
              => String -- ^ title
-             -> Hamlet (Routes master) -- ^ body
+             -> Hamlet (Route master) -- ^ body
              -> GHandler sub master ChooseRep
 applyLayout' s = fmap chooseRep . applyLayout s mempty
 
 -- | The default error handler for 'errorHandler'.
-defaultErrorHandler :: Yesod y
-                    => ErrorResponse
-                    -> Handler y ChooseRep
+defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
 defaultErrorHandler NotFound = do
     r <- waiRequest
     applyLayout' "Not Found" $ [$hamlet|
 %h1 Not Found
-%p $string.toString.pathInfo.r$
+%p $toString.pathInfo.r$
 |]
   where
     pathInfo = W.pathInfo
 defaultErrorHandler (PermissionDenied msg) =
     applyLayout' "Permission Denied" $ [$hamlet|
 %h1 Permission denied
-%p $string.msg$
+%p $msg$
 |]
 defaultErrorHandler (InvalidArgs ia) =
     applyLayout' "Invalid Arguments" $ [$hamlet|
 %h1 Invalid Arguments
-%dl
-    $forall ia pair
-        %dt $string.fst.pair$
-        %dd $string.snd.pair$
+%ul
+    $forall ia msg
+        %li $msg$
 |]
 defaultErrorHandler (InternalError e) =
     applyLayout' "Internal Server Error" $ [$hamlet|
 %h1 Internal Server Error
-%p $string.e$
+%p $e$
 |]
 defaultErrorHandler (BadMethod m) =
     applyLayout' "Bad Method" $ [$hamlet|
 %h1 Method Not Supported
-%p Method "$string.m$" not supported
+%p Method "$m$" not supported
 |]
 
 class YesodPersist y where
     type YesodDB y :: (* -> *) -> * -> *
     runDB :: YesodDB y (GHandler sub y) a -> GHandler sub y a
+
+
+-- Get the given entity by ID, or return a 404 not found if it doesn't exist.
+get404 :: (PersistBackend (t m), PersistEntity val, Monad (t m),
+           Failure ErrorResponse m, MonadTrans t)
+       => Key val -> t m val
+get404 key = do
+    mres <- get key
+    case mres of
+        Nothing -> lift notFound
+        Just res -> return res
+
+-- | Return the same URL if the user is authorized to see it.
+--
+-- 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
+    return $ if x == Authorized then Just r else Nothing
diff --git a/scaffold.hs b/scaffold.hs
new file mode 100644
--- /dev/null
+++ b/scaffold.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE QuasiQuotes #-}
+import CodeGen
+import System.IO
+import System.Directory
+
+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.
+
+Your name: |]
+    hFlush stdout
+    name <- getLine
+
+    putStr [$codegen|
+Welcome ~name~.
+What do you want to call your project? We'll use this for the cabal name and
+executable filenames.
+
+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.
+
+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|
+name:              ~project~
+version:           0.0.0
+license:           BSD3
+license-file:      LICENSE
+author:            ~name~
+maintainer:        ~name~
+synopsis:          The greatest Yesod web application ever.
+description:       I'm sure you can say something clever here if you try.
+category:          Web
+stability:         Experimental
+cabal-version:     >= 1.6
+build-type:        Simple
+homepage:          http://www.yesodweb.com/~project~
+
+executable         ~project~
+    build-depends: base >= 4 && < 5,
+                   yesod >= 0.4.0 && < 0.5.0,
+                   persistent-sqlite >= 0.1.0 && < 0.2
+    ghc-options:   -Wall
+    main-is:       ~project~.hs
+|]
+
+    putStrLn "Generating LICENSE"
+    writeFile "LICENSE" [$codegen|
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+Copyright 2010, ~name~. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+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
+    ( ~sitearg~ (..)
+    , with~sitearg~
+    ) where
+import Yesod
+import Yesod.Helpers.Crud
+import Yesod.Helpers.Static
+import Database.Persist.Sqlite
+import Model
+
+data ~sitearg~ = ~sitearg~
+    { connPool :: Pool Connection
+    , static :: Static
+    }
+
+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 PersonCrud = Crud ~sitearg~ Person
+
+mkYesod "~sitearg~" [$parseRoutes|
+/       RootR   GET
+/people PeopleR PersonCrud defaultCrud
+/static StaticR Static static
+|~~]
+
+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^
+|~~]
+      where
+        stylesheet = StaticR $ StaticRoute ["style.css"]
+
+instance YesodPersist ~sitearg~ where
+    type YesodDB ~sitearg~ = SqliteReader
+    runDB db = fmap connPool getYesod >>= runSqlite 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!
+%p
+    %a!href=@PeopleR.CrudListR@ Manage people
+|~~]
+|]
+
+    putStrLn "Generating Model.hs"
+    writeFile "Model.hs" [$codegen|
+{-# LANGUAGE GeneralizedNewtypeDeriving, QuasiQuotes, TypeFamilies #-}
+
+-- We don't explicitly state our export list, since there are funny things
+-- that happen with type family constructors.
+module Model where
+
+import Yesod
+import Yesod.Helpers.Crud
+
+share2 mkPersist mkToForm [$persist|
+Person
+    name String
+    age Int
+|~~]
+
+instance Item Person where
+    itemTitle = personName
+|]
+
+    putStrLn "Generating static/style.css"
+    createDirectoryIfMissing True "static"
+    writeFile "static/style.css" [$codegen|
+body {
+    font-family: sans-serif;
+    background: #eee;
+}
+
+#wrapper {
+    width: 760px;
+    margin: 1em auto;
+    border: 2px solid #000;
+    padding: 0.5em;
+    background: #fff;
+}
+|]
diff --git a/yesod.cabal b/yesod.cabal
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -1,5 +1,5 @@
 name:            yesod
-version:         0.3.1.1
+version:         0.4.0
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -21,18 +21,18 @@
 
 library
     build-depends:   base >= 4 && < 5,
-                     time >= 1.1.3 && < 1.2,
-                     wai >= 0.1.0 && < 0.2,
-                     wai-extra >= 0.1.3 && < 0.2,
-                     authenticate >= 0.6.2 && < 0.7,
+                     time >= 1.1.4 && < 1.3,
+                     wai >= 0.2.0 && < 0.3,
+                     wai-extra >= 0.2.0 && < 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.4 && < 0.5,
-                     hamlet >= 0.3.1 && < 0.4,
+                     web-routes-quasi >= 0.5 && < 0.6,
+                     hamlet >= 0.4.0 && < 0.5,
                      transformers >= 0.2 && < 0.3,
                      clientsession >= 0.4.0 && < 0.5,
                      pureMD5 >= 1.1.0.0 && < 1.2,
@@ -40,17 +40,21 @@
                      control-monad-attempt >= 0.3 && < 0.4,
                      cereal >= 0.2 && < 0.3,
                      old-locale >= 1.0.0.2 && < 1.1,
-                     persistent >= 0.0.0 && < 0.1
+                     persistent >= 0.1.0 && < 0.2,
+                     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
     exposed-modules: Yesod
                      Yesod.Content
                      Yesod.Dispatch
                      Yesod.Form
-                     Yesod.Formable
                      Yesod.Hamlet
                      Yesod.Handler
                      Yesod.Internal
                      Yesod.Json
                      Yesod.Request
+                     Yesod.Widget
                      Yesod.Yesod
                      Yesod.Helpers.AtomFeed
                      Yesod.Helpers.Auth
@@ -58,6 +62,11 @@
                      Yesod.Helpers.Sitemap
                      Yesod.Helpers.Static
     ghc-options:     -Wall
+
+executable             yesod
+    build-depends:     parsec >= 2.1 && < 4
+    ghc-options:       -Wall
+    main-is:           scaffold.hs
 
 executable             runtests
     if flag(buildtests)