diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,25 +1,25 @@
-The following license covers this documentation, and the source code, except
-where otherwise indicated.
-
-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:
-
-* 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.
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+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:
+
+* 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.
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -1,7 +1,7 @@
-#!/usr/bin/env runhaskell
-
-> module Main where
-> import Distribution.Simple
-
-> main :: IO ()
-> main = defaultMain
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/Yesod/Form.hs b/Yesod/Form.hs
--- a/Yesod/Form.hs
+++ b/Yesod/Form.hs
@@ -1,313 +1,14 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
--- | Parse forms (and query strings).
-module Yesod.Form
-    ( -- * Data types
-      GForm
-    , FormResult (..)
-    , Enctype (..)
-    , FormFieldSettings (..)
-    , Textarea (..)
-    , FieldInfo (..)
-      -- ** Utilities
-    , formFailures
-      -- * Type synonyms
-    , Form
-    , Formlet
-    , FormField
-    , FormletField
-    , FormInput
-      -- * Unwrapping functions
-    , generateForm
-    , runFormGet
-    , runFormMonadGet
-    , runFormPost
-    , runFormPostNoNonce
-    , runFormMonadPost
-    , runFormGet'
-    , runFormPost'
-      -- ** High-level form post unwrappers
-    , runFormTable
-    , runFormDivs
-      -- * Field/form helpers
-    , fieldsToTable
-    , fieldsToDivs
-    , fieldsToPlain
-    , checkForm
-      -- * Type classes
-    , module Yesod.Form.Class
-      -- * Template Haskell
-    , mkToForm
-    , module Yesod.Form.Fields
-    ) where
-
-import Yesod.Form.Core
-import Yesod.Form.Fields
-import Yesod.Form.Class
-import Yesod.Form.Profiles (Textarea (..))
-import Yesod.Widget (GWidget)
-
-import Text.Hamlet
-import Yesod.Request
-import Yesod.Handler
-import Control.Applicative hiding (optional)
-import Data.Maybe (fromMaybe, mapMaybe)
-import Control.Monad ((<=<))
-import Language.Haskell.TH.Syntax hiding (lift)
-import Database.Persist.Base (EntityDef (..), PersistEntity (entityDef))
-import Data.Char (toUpper, isUpper)
-import Control.Arrow ((&&&))
-import Data.List (group, sort)
-import Data.Monoid (mempty)
-import Data.Text (Text)
-
-#if __GLASGOW_HASKELL__ >= 700
-#define HAMLET hamlet
-#else
-#define HAMLET $hamlet
-#endif
--- | Display only the actual input widget code, without any decoration.
-fieldsToPlain :: FormField sub y a -> Form sub y a
-fieldsToPlain = mapFormXml $ mapM_ fiInput
-
--- | Display the label, tooltip, input code and errors in a single row of a
--- table.
-fieldsToTable :: FormField sub y a -> Form sub y a
-fieldsToTable = mapFormXml $ mapM_ go
-  where
-    go fi = [HAMLET|
-<tr .#{clazz fi}>
-    <td>
-        <label for="#{fiIdent fi}">#{fiLabel fi}
-        <div .tooltip>#{fiTooltip fi}
-    <td>
-        \^{fiInput fi}
-    $maybe err <- fiErrors fi
-        <td .errors>#{err}
-|]
-    clazz fi = if fiRequired fi then "required" else "optional" :: Text
-
--- | Display the label, tooltip, input code and errors in a single div.
-fieldsToDivs :: FormField sub y a -> Form sub y a
-fieldsToDivs = mapFormXml $ mapM_ go
-  where
-    go fi = [HAMLET|
-<div .#{clazz fi}>
-    <label for="#{fiIdent fi}">#{fiLabel fi}
-        <div .tooltip>#{fiTooltip fi}
-    \^{fiInput fi}
-    $maybe err <- fiErrors fi
-        <div .errors>#{err}
-|]
-    clazz fi = if fiRequired fi then "required" else "optional" :: Text
-
--- | Run a form against POST parameters, without CSRF protection.
-runFormPostNoNonce :: GForm s m xml a -> GHandler s m (FormResult a, xml, Enctype)
-runFormPostNoNonce f = do
-    (pp, files) <- runRequestBody
-    runFormGeneric pp files f
-
--- | Run a form against POST parameters.
---
--- This function includes CSRF protection by checking a nonce value. You must
--- therefore embed this nonce in the form as a hidden field; that is the
--- meaning of the fourth element in the tuple.
-runFormPost :: GForm s m xml a -> GHandler s m (FormResult a, xml, Enctype, Html)
-runFormPost f = do
-    (pp, files) <- runRequestBody
-    nonce <- fmap reqNonce getRequest
-    (res, xml, enctype) <- runFormGeneric pp files f
-    let res' =
-            case res of
-                FormSuccess x ->
-                    if lookup nonceName pp == nonce
-                        then FormSuccess x
-                        else FormFailure ["As a protection against cross-site request forgery attacks, please confirm your form submission."]
-                _ -> res
-    return (res', xml, enctype, maybe mempty hidden nonce)
-  where
-    hidden nonce = [HAMLET|
-    <input type="hidden" name="#{nonceName}" value="#{nonce}">
-|]
-
-nonceName :: Text
-nonceName = "_nonce"
-
--- | Run a form against POST parameters. Please note that this does not provide
--- CSRF protection.
-runFormMonadPost :: GFormMonad s m a -> GHandler s m (a, Enctype)
-runFormMonadPost f = do
-    (pp, files) <- runRequestBody
-    runFormGeneric pp files f
-
--- | Run a form against POST parameters, disregarding the resulting HTML and
--- returning an error response on invalid input. Note: this does /not/ perform
--- CSRF protection.
-runFormPost' :: GForm sub y xml a -> GHandler sub y a
-runFormPost' f = do
-    (pp, files) <- runRequestBody
-    x <- runFormGeneric pp files f
-    helper x
-
--- | Create a table-styled form.
---
--- This function wraps around 'runFormPost' and 'fieldsToTable', taking care of
--- some of the boiler-plate in creating forms. In particular, is automatically
--- creates the form element, sets the method, action and enctype attributes,
--- adds the CSRF-protection nonce hidden field and inserts a submit button.
-runFormTable :: Route m -> String -> FormField s m a
-             -> GHandler s m (FormResult a, GWidget s m ())
-runFormTable dest inputLabel form = do
-    (res, widget, enctype, nonce) <- runFormPost $ fieldsToTable form
-    return (res, [HAMLET|
-<form method="post" action="@{dest}" enctype="#{enctype}">
-    <table>
-        \^{widget}
-        <tr>
-            <td colspan="2">
-                \#{nonce}
-                <input type="submit" value="#{inputLabel}">
-|])
-
--- | Same as 'runFormPostTable', but uses 'fieldsToDivs' for styling.
-runFormDivs :: Route m -> String -> FormField s m a
-            -> GHandler s m (FormResult a, GWidget s m ())
-runFormDivs dest inputLabel form = do
-    (res, widget, enctype, nonce) <- runFormPost $ fieldsToDivs form
-    return (res, [HAMLET|
-<form method="post" action="@{dest}" enctype="#{enctype}">
-    \^{widget}
-    <div>
-        \#{nonce}
-        <input type="submit" value="#{inputLabel}">
-|])
-
--- | 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"]
-
--- | Generate a form, feeding it no data. The third element in the result tuple
--- is a nonce hidden field.
-generateForm :: GForm s m xml a -> GHandler s m (xml, Enctype, Html)
-generateForm f = do
-    (_, b, c) <- runFormGeneric [] [] f
-    nonce <- fmap reqNonce getRequest
-    return (b, c, [HAMLET|\
-$maybe n <- nonce
-    <input type="hidden" name="#{nonceName}" value="#{n}">
-|])
-
--- | Run a form against GET parameters.
-runFormGet :: GForm s m xml a -> GHandler s m (FormResult a, xml, Enctype)
-runFormGet f = do
-    gs <- reqGetParams `fmap` getRequest
-    runFormGeneric gs [] f
-
-runFormMonadGet :: GFormMonad s m a -> GHandler s m (a, Enctype)
-runFormMonadGet f = do
-    gs <- reqGetParams `fmap` getRequest
-    runFormGeneric gs [] f
-
--- | Create 'ToForm' instances for the given entity. In addition to regular 'EntityDef' attributes understood by persistent, it also understands label= and tooltip=.
-mkToForm :: PersistEntity v => v -> Q [Dec]
-mkToForm =
-    fmap return . derive . entityDef
-  where
-    afterPeriod s =
-        case dropWhile (/= '.') s of
-            ('.':t) -> t
-            _ -> s
-    beforePeriod s =
-        case break (== '.') s of
-            (t, '.':_) -> Just t
-            _ -> Nothing
-    getSuperclass (_, _, z) = getTFF' z >>= beforePeriod
-    getTFF (_, _, z) = maybe "toFormField" afterPeriod $ getTFF' z
-    getTFF' [] = Nothing
-    getTFF' (('t':'o':'F':'o':'r':'m':'F':'i':'e':'l':'d':'=':x):_) = Just x
-    getTFF' (_:x) = getTFF' x
-    getLabel (x, _, z) = fromMaybe (toLabel x) $ getLabel' z
-    getLabel' [] = Nothing
-    getLabel' (('l':'a':'b':'e':'l':'=':x):_) = Just x
-    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
-    getId (_, _, z) = fromMaybe "" $ getId' z
-    getId' (('i':'d':'=':x):_) = Just x
-    getId' (_:x) = getId' x
-    getId' [] = Nothing
-    getName (_, _, z) = fromMaybe "" $ getName' z
-    getName' (('n':'a':'m':'e':'=':x):_) = Just x
-    getName' (_:x) = getName' x
-    getName' [] = Nothing
-    derive :: EntityDef -> Q Dec
-    derive t = do
-        let cols = map ((getId &&& getName) &&& ((getLabel &&& getTooltip) &&& getTFF)) $ entityColumns t
-        ap <- [|(<*>)|]
-        just <- [|pure|]
-        nothing <- [|Nothing|]
-        let just' = just `AppE` ConE (mkName $ entityName t)
-        string' <- [|toHtml|]
-        ftt <- [|fieldsToTable|]
-        ffs' <- [|FormFieldSettings|]
-        let stm "" = nothing
-            stm x = just `AppE` LitE (StringL x)
-        let go_ = go ap just' ffs' stm string' 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')
-                        []
-        let y = mkName "y"
-        let ctx = map (\x -> ClassP (mkName x) [VarT y])
-                $ map head $ group $ sort
-                $ mapMaybe getSuperclass
-                $ entityColumns t
-        return $ InstanceD ctx ( ConT ''ToForm
-                              `AppT` ConT (mkName $ entityName t)
-                              `AppT` VarT y)
-            [FunD (mkName "toForm") [c1, c2]]
-    go ap just' ffs' stm string' ftt a =
-        let x = foldl (ap' ap) just' $ map (go' ffs' stm string') a
-         in ftt `AppE` x
-    go' ffs' stm string' (((theId, name), ((label, tooltip), tff)), ex) =
-        let label' = LitE $ StringL label
-            tooltip' = string' `AppE` LitE (StringL tooltip)
-            ffs = ffs' `AppE`
-                  label' `AppE`
-                  tooltip' `AppE`
-                  (stm theId) `AppE`
-                  (stm name)
-         in VarE (mkName tff) `AppE` ffs `AppE` ex
-    ap' ap x y = InfixE (Just x) ap (Just y)
-
-toLabel :: String -> String
-toLabel "" = ""
-toLabel (x:rest) = toUpper x : go rest
-  where
-    go "" = ""
-    go (c:cs)
-        | isUpper c = ' ' : c : go cs
-        | otherwise = c : go cs
-
-formFailures :: FormResult a -> Maybe [Text]
-formFailures (FormFailure x) = Just x
-formFailures _ = Nothing
+-- | Parse forms (and query strings).
+module Yesod.Form
+    ( module Yesod.Form.Types
+    , module Yesod.Form.Functions
+    , module Yesod.Form.Fields
+    , module Yesod.Form.Class
+    , module Yesod.Form.Input
+    ) where
+
+import Yesod.Form.Types
+import Yesod.Form.Functions
+import Yesod.Form.Fields
+import Yesod.Form.Class
+import Yesod.Form.Input
diff --git a/Yesod/Form/Class.hs b/Yesod/Form/Class.hs
--- a/Yesod/Form/Class.hs
+++ b/Yesod/Form/Class.hs
@@ -1,69 +1,77 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-module Yesod.Form.Class
-    ( ToForm (..)
-    , ToFormField (..)
-    ) where
-
-import Text.Hamlet
-import Yesod.Form.Fields
-import Yesod.Form.Core
-import Yesod.Form.Profiles (Textarea)
-import Data.Int (Int64)
-import Data.Time (Day, TimeOfDay)
-import Data.Text (Text)
-
-class ToForm a y where
-    toForm :: Formlet sub y a
-class ToFormField a y where
-    toFormField :: FormFieldSettings -> FormletField sub y a
-
-{- FIXME
-instance ToFormField String y where
-    toFormField = stringField
-instance ToFormField (Maybe String) y where
-    toFormField = maybeStringField
--}
-
-instance ToFormField Text y where
-    toFormField = stringField
-instance ToFormField (Maybe Text) y where
-    toFormField = maybeStringField
-
-instance ToFormField Int y where
-    toFormField = intField
-instance ToFormField (Maybe Int) y where
-    toFormField = maybeIntField
-instance ToFormField Int64 y where
-    toFormField = intField
-instance ToFormField (Maybe Int64) y where
-    toFormField = maybeIntField
-
-instance ToFormField Double y where
-    toFormField = doubleField
-instance ToFormField (Maybe Double) y where
-    toFormField = maybeDoubleField
-
-instance ToFormField Day y where
-    toFormField = dayField
-instance ToFormField (Maybe Day) y where
-    toFormField = maybeDayField
-
-instance ToFormField TimeOfDay y where
-    toFormField = timeField
-instance ToFormField (Maybe TimeOfDay) y where
-    toFormField = maybeTimeField
-
-instance ToFormField Bool y where
-    toFormField = boolField
-
-instance ToFormField Html y where
-    toFormField = htmlField
-instance ToFormField (Maybe Html) y where
-    toFormField = maybeHtmlField
-
-instance ToFormField Textarea y where
-    toFormField = textareaField
-instance ToFormField (Maybe Textarea) y where
-    toFormField = maybeTextareaField
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Yesod.Form.Class
+    ( ToForm (..)
+    , ToField (..)
+    ) where
+
+import Text.Hamlet
+import Yesod.Widget (GGWidget)
+import Yesod.Form.Fields
+import Yesod.Form.Types
+import Yesod.Form.Functions (areq, aopt)
+import Data.Int (Int64)
+import Data.Time (Day, TimeOfDay)
+import Data.Text (Text)
+import Yesod.Handler (GGHandler)
+import Yesod.Message (RenderMessage)
+
+class ToForm a master monad where
+    toForm :: AForm ([FieldView (GGWidget master monad ())] -> [FieldView (GGWidget master monad ())]) master monad a
+
+class ToField a master monad where
+    toField :: RenderMessage master msg => FieldSettings msg -> Maybe a -> AForm ([FieldView (GGWidget master monad ())] -> [FieldView (GGWidget master monad ())]) master monad a
+
+{- FIXME
+instance ToFormField String y where
+    toFormField = stringField
+instance ToFormField (Maybe String) y where
+    toFormField = maybeStringField
+-}
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Text master (GGHandler sub master m) where
+    toField = areq textField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Text) master (GGHandler sub master m) where
+    toField = aopt textField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Int master (GGHandler sub master m) where
+    toField = areq intField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Int) master (GGHandler sub master m) where
+    toField = aopt intField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Int64 master (GGHandler sub master m) where
+    toField = areq intField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Int64) master (GGHandler sub master m) where
+    toField = aopt intField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Double master (GGHandler sub master m) where
+    toField = areq doubleField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Double) master (GGHandler sub master m) where
+    toField = aopt doubleField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Day master (GGHandler sub master m) where
+    toField = areq dayField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Day) master (GGHandler sub master m) where
+    toField = aopt dayField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField TimeOfDay master (GGHandler sub master m) where
+    toField = areq timeField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe TimeOfDay) master (GGHandler sub master m) where
+    toField = aopt timeField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Html master (GGHandler sub master m) where
+    toField = areq htmlField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Html) master (GGHandler sub master m) where
+    toField = aopt htmlField
+
+instance (Monad m, RenderMessage master FormMessage) => ToField Textarea master (GGHandler sub master m) where
+    toField = areq textareaField
+instance (Monad m, RenderMessage master FormMessage) => ToField (Maybe Textarea) master (GGHandler sub master m) where
+    toField = aopt textareaField
+
+{- FIXME
+instance ToFormField Bool y where
+    toFormField = boolField
+-}
diff --git a/Yesod/Form/Core.hs b/Yesod/Form/Core.hs
deleted file mode 100644
--- a/Yesod/Form/Core.hs
+++ /dev/null
@@ -1,376 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeSynonymInstances #-}
--- | Users of the forms library should not need to use this module in general.
--- It is intended only for writing custom forms and form fields.
-module Yesod.Form.Core
-    ( FormResult (..)
-    , GForm (..)
-    , newFormIdent
-    , deeperFormIdent
-    , shallowerFormIdent
-    , Env
-    , FileEnv
-    , Enctype (..)
-    , Ints (..)
-    , requiredFieldHelper
-    , optionalFieldHelper
-    , fieldsToInput
-    , mapFormXml
-    , checkForm
-    , checkField
-    , askParams
-    , askFiles
-    , liftForm
-    , IsForm (..)
-    , RunForm (..)
-    , GFormMonad
-      -- * Data types
-    , FieldInfo (..)
-    , FormFieldSettings (..)
-    , FieldProfile (..)
-      -- * Type synonyms
-    , Form
-    , Formlet
-    , FormField
-    , FormletField
-    , FormInput
-    ) where
-
-import Control.Monad.Trans.State
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Writer
-import Control.Monad.Trans.Class (lift)
-import Yesod.Handler
-import Yesod.Widget
-import Data.Monoid (Monoid (..))
-import Control.Applicative
-import Yesod.Request
-import Control.Monad (liftM)
-import Text.Hamlet
-import Text.Blaze (ToHtml (..))
-import Data.String
-import Control.Monad (join)
-import Data.Text (Text, pack)
-import qualified Data.Text as T
-import Prelude hiding ((++))
-
-(++) :: Monoid a => a -> a -> a
-(++) = mappend
-
--- | 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 [Text]
-                  | FormSuccess a
-    deriving Show
-instance Functor FormResult where
-    fmap _ FormMissing = FormMissing
-    fmap _ (FormFailure errs) = FormFailure errs
-    fmap f (FormSuccess a) = FormSuccess $ f a
-instance Applicative FormResult where
-    pure = FormSuccess
-    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
-    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
-    (FormFailure x) <*> _ = FormFailure x
-    _ <*> (FormFailure y) = FormFailure y
-    _ <*> _ = FormMissing
-instance Monoid m => Monoid (FormResult m) where
-    mempty = pure mempty
-    mappend x y = mappend <$> x <*> y
-
--- | The encoding type required by a form. The 'Show' instance produces values
--- that can be inserted directly into HTML.
-data Enctype = UrlEncoded | Multipart
-    deriving (Eq, Enum, Bounded)
-instance ToHtml Enctype where
-    toHtml UrlEncoded = unsafeByteString "application/x-www-form-urlencoded"
-    toHtml Multipart = unsafeByteString "multipart/form-data"
-instance Monoid Enctype where
-    mempty = UrlEncoded
-    mappend UrlEncoded UrlEncoded = UrlEncoded
-    mappend _ _ = Multipart
-
-data Ints = IntCons Int Ints | IntSingle Int
-instance Show Ints where
-    show (IntSingle i) = show i
-    show (IntCons i is) = show i ++ ('-' : show is)
-
-incrInts :: Ints -> Ints
-incrInts (IntSingle i) = IntSingle $ i + 1
-incrInts (IntCons i is) = (i + 1) `IntCons` is
-
--- | A generic form, allowing you to specifying the subsite datatype, master
--- site datatype, a datatype for the form XML and the return type.
-newtype GForm s m xml a = GForm
-    { deform :: FormInner s m (FormResult a, xml, Enctype)
-    }
-
-type GFormMonad s m a = WriterT Enctype (FormInner s m) a
-
-type FormInner s m =
-    StateT Ints (
-    ReaderT Env (
-    ReaderT FileEnv (
-    GHandler s m
-    )))
-
-type Env = [(Text, Text)]
-type FileEnv = [(Text, FileInfo)]
-
--- | Get a unique identifier.
-newFormIdent :: Monad m => StateT Ints m Text
-newFormIdent = do
-    i <- get
-    let i' = incrInts i
-    put i'
-    return $ pack $ 'f' : show i'
-
-deeperFormIdent :: Monad m => StateT Ints m ()
-deeperFormIdent = do
-    i <- get
-    let i' = 1 `IntCons` incrInts i
-    put i'
-
-shallowerFormIdent :: Monad m => StateT Ints m ()
-shallowerFormIdent = do
-    IntCons _ i <- get
-    put i
-
-instance Monoid xml => Functor (GForm sub url xml) where
-    fmap f (GForm g) =
-        GForm $ liftM (first3 $ fmap f) g
-      where
-        first3 f' (x, y, z) = (f' x, y, z)
-
-instance Monoid xml => Applicative (GForm sub url xml) where
-    pure a = GForm $ return (pure a, mempty, mempty)
-    (GForm f) <*> (GForm g) = GForm $ do
-        (f1, f2, f3) <- f
-        (g1, g2, g3) <- g
-        return (f1 <*> g1, f2 `mappend` g2, f3 `mappend` g3)
-
--- | Create a required field (ie, one that cannot be blank) from a
--- 'FieldProfile'.
-requiredFieldHelper
-    :: IsForm f
-    => FieldProfile (FormSub f) (FormMaster f) (FormType f)
-    -> FormFieldSettings
-    -> Maybe (FormType f)
-    -> f
-requiredFieldHelper (FieldProfile parse render mkWidget) ffs orig = toForm $ do
-    env <- lift ask
-    let (FormFieldSettings label tooltip theId' name') = ffs
-    name <- maybe newFormIdent return name'
-    theId <- maybe newFormIdent return theId'
-    let (res, val) =
-            if null env
-                then (FormMissing, maybe "" render orig)
-                else case lookup name env of
-                        Nothing -> (FormMissing, "")
-                        Just "" -> (FormFailure ["Value is required"], "")
-                        Just x ->
-                            case parse x of
-                                Left e -> (FormFailure [e], x)
-                                Right y -> (FormSuccess y, x)
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = mkWidget theId name val True
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ toHtml x
-                            _ -> Nothing
-            , fiRequired = True
-            }
-    let res' = case res of
-                FormFailure [e] -> FormFailure [label ++ ": " ++ e]
-                _ -> res
-    return (res', fi, UrlEncoded)
-
-class IsForm f where
-    type FormSub f
-    type FormMaster f
-    type FormType f
-    toForm :: FormInner
-                (FormSub f)
-                (FormMaster f)
-                (FormResult (FormType f),
-                 FieldInfo (FormSub f) (FormMaster f),
-                 Enctype) -> f
-instance IsForm (FormField s m a) where
-    type FormSub (FormField s m a) = s
-    type FormMaster (FormField s m a) = m
-    type FormType (FormField s m a) = a
-    toForm x = GForm $ do
-        (a, b, c) <- x
-        return (a, [b], c)
-instance (FormResult ~ formResult) => IsForm (GFormMonad s m (formResult a, FieldInfo s m)) where
-    type FormSub (GFormMonad s m (formResult a, FieldInfo s m)) = s
-    type FormMaster (GFormMonad s m (formResult a, FieldInfo s m)) = m
-    type FormType (GFormMonad s m (formResult a, FieldInfo s m)) = a
-    toForm x = do
-        (res, fi, enctype) <- lift x
-        tell enctype
-        return (res, fi)
-
-class RunForm f where
-    type RunFormSub f
-    type RunFormMaster f
-    type RunFormType f
-    runFormGeneric :: Env -> FileEnv -> f
-                   -> GHandler (RunFormSub f)
-                               (RunFormMaster f)
-                               (RunFormType f)
-
-instance RunForm (GForm s m xml a) where
-    type RunFormSub (GForm s m xml a) = s
-    type RunFormMaster (GForm s m xml a) = m
-    type RunFormType (GForm s m xml a) =
-        (FormResult a, xml, Enctype)
-    runFormGeneric env fe (GForm f) =
-        runReaderT (runReaderT (evalStateT f $ IntSingle 1) env) fe
-
-instance RunForm (GFormMonad s m a) where
-    type RunFormSub (GFormMonad s m a) = s
-    type RunFormMaster (GFormMonad s m a) = m
-    type RunFormType (GFormMonad s m a) = (a, Enctype)
-    runFormGeneric e fe f =
-        runReaderT (runReaderT (evalStateT (runWriterT f) $ IntSingle 1) e) fe
-
--- | Create an optional field (ie, one that can be blank) from a
--- 'FieldProfile'.
-optionalFieldHelper
-    :: (IsForm f, Maybe b ~ FormType f)
-    => FieldProfile (FormSub f) (FormMaster f) b
-    -> FormFieldSettings
-    -> Maybe (Maybe b)
-    -> f
-optionalFieldHelper (FieldProfile parse render mkWidget) ffs orig' = toForm $ do
-    env <- lift ask
-    let (FormFieldSettings label tooltip theId' name') = ffs
-    let orig = join orig'
-    name <- maybe newFormIdent return name'
-    theId <- maybe newFormIdent return theId'
-    let (res, val) =
-            if null env
-                then (FormSuccess Nothing, maybe "" render orig)
-                else case lookup name env of
-                        Nothing -> (FormSuccess Nothing, "")
-                        Just "" -> (FormSuccess Nothing, "")
-                        Just x ->
-                            case parse x of
-                                Left e -> (FormFailure [e], x)
-                                Right y -> (FormSuccess $ Just y, x)
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = mkWidget theId name val False
-            , fiErrors = case res of
-                            FormFailure x -> Just $ toHtml $ T.unlines x
-                            _ -> Nothing
-            , fiRequired = False
-            }
-    let res' = case res of
-                FormFailure [e] -> FormFailure [label ++ ": " ++ e]
-                _ -> res
-    return (res', fi, UrlEncoded)
-
-fieldsToInput :: [FieldInfo sub y] -> [GWidget sub y ()]
-fieldsToInput = map fiInput
-
--- | Convert the XML in a 'GForm'.
-mapFormXml :: (xml1 -> xml2) -> GForm s y xml1 a -> GForm s y xml2 a
-mapFormXml f (GForm g) = GForm $ do
-    (res, xml, enc) <- g
-    return (res, f xml, enc)
-
--- | Using this as the intermediate XML representation for fields allows us to
--- write generic field functions and then different functions for producing
--- actual HTML. See, for example, 'fieldsToTable' and 'fieldsToPlain'.
-data FieldInfo sub y = FieldInfo
-    { fiLabel :: Html
-    , fiTooltip :: Html
-    , fiIdent :: Text
-    , fiInput :: GWidget sub y ()
-    , fiErrors :: Maybe Html
-    , fiRequired :: Bool
-    }
-
-data FormFieldSettings = FormFieldSettings
-    { ffsLabel :: Text
-    , ffsTooltip :: Html
-    , ffsId :: Maybe Text
-    , ffsName :: Maybe Text
-    }
-instance IsString FormFieldSettings where
-    fromString s = FormFieldSettings (pack s) mempty Nothing Nothing
-
--- | A generic definition of a form field that can be used for generating both
--- required and optional fields. See 'requiredFieldHelper and
--- 'optionalFieldHelper'.
-data FieldProfile sub y a = FieldProfile
-    { fpParse :: Text -> Either Text a
-    , fpRender :: a -> Text
-    -- | ID, name, value, required
-    , fpWidget :: Text -> Text -> Text -> Bool -> GWidget sub y ()
-    }
-
-type Form sub y = GForm sub y (GWidget sub y ())
-type Formlet sub y a = Maybe a -> Form sub y a
-type FormField sub y = GForm sub y [FieldInfo sub y]
-type FormletField sub y a = Maybe a -> FormField sub y a
-type FormInput sub y = GForm sub y [GWidget sub y ()]
-
--- | Add a validation check to a form.
---
--- Note that if there is a validation error, this message will /not/
--- automatically appear on the form; for that, you need to use 'checkField'.
-checkForm :: (a -> FormResult b) -> GForm s m x a -> GForm s m x b
-checkForm f (GForm form) = GForm $ do
-    (res, xml, enc) <- form
-    let res' = case res of
-                    FormSuccess a -> f a
-                    FormFailure e -> FormFailure e
-                    FormMissing -> FormMissing
-    return (res', xml, enc)
-
--- | Add a validation check to a 'FormField'.
---
--- Unlike 'checkForm', the validation error will appear in the generated HTML
--- of the form.
-checkField :: (a -> Either Text b) -> FormField s m a -> FormField s m b
-checkField f (GForm form) = GForm $ do
-    (res, xml, enc) <- form
-    let (res', merr) =
-            case res of
-                FormSuccess a ->
-                    case f a of
-                        Left e -> (FormFailure [e], Just e)
-                        Right x -> (FormSuccess x, Nothing)
-                FormFailure e -> (FormFailure e, Nothing)
-                FormMissing -> (FormMissing, Nothing)
-    let xml' =
-            case merr of
-                Nothing -> xml
-                Just err -> flip map xml $ \fi -> fi
-                    { fiErrors = Just $
-                        case fiErrors fi of
-                            Nothing -> toHtml err
-                            Just x -> x
-                    }
-    return (res', xml', enc)
-
-askParams :: Monad m => StateT Ints (ReaderT Env m) Env
-askParams = lift ask
-
-askFiles :: Monad m => StateT Ints (ReaderT Env (ReaderT FileEnv m)) FileEnv
-askFiles = lift $ lift ask
-
-liftForm :: Monad m => m a -> StateT Ints (ReaderT Env (ReaderT FileEnv m)) a
-liftForm = lift . lift . lift
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
--- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs
@@ -1,509 +1,392 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Yesod.Form.Fields
-    ( -- * Fields
-      -- ** Required
-      stringField
-    , passwordField
-    , textareaField
-    , hiddenField
-    , intField
-    , doubleField
-    , dayField
-    , timeField
-    , htmlField
-    , selectField
-    , radioField
-    , boolField
-    , emailField
-    , searchField
-    , urlField
-    , fileField
-      -- ** Optional
-    , maybeStringField
-    , maybePasswordField
-    , maybeTextareaField
-    , maybeHiddenField
-    , maybeIntField
-    , maybeDoubleField
-    , maybeDayField
-    , maybeTimeField
-    , maybeHtmlField
-    , maybeSelectField
-    , maybeRadioField
-    , maybeEmailField
-    , maybeSearchField
-    , maybeUrlField
-    , maybeFileField
-      -- * Inputs
-      -- ** Required
-    , stringInput
-    , intInput
-    , boolInput
-    , dayInput
-    , emailInput
-    , urlInput
-      -- ** Optional
-    , maybeStringInput
-    , maybeDayInput
-    , maybeIntInput
-    ) where
-
-import Yesod.Form.Core
-import Yesod.Form.Profiles
-import Yesod.Request (FileInfo)
-import Yesod.Widget (GWidget)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Reader (ask)
-import Data.Time (Day, TimeOfDay)
-import Text.Hamlet
-import Data.Monoid
-import Control.Monad (join)
-import Data.Maybe (fromMaybe, isNothing)
-import Data.Text (Text, unpack)
-import qualified Data.Text as T
-
-#if __GLASGOW_HASKELL__ >= 700
-#define HAMLET hamlet
-#else
-#define HAMLET $hamlet
-#endif
-
-stringField :: (IsForm f, FormType f ~ Text)
-            => FormFieldSettings -> Maybe Text -> f
-stringField = requiredFieldHelper stringFieldProfile
-
-maybeStringField :: (IsForm f, FormType f ~ Maybe Text)
-                 => FormFieldSettings -> Maybe (Maybe Text) -> f
-maybeStringField = optionalFieldHelper stringFieldProfile
-
-passwordField :: (IsForm f, FormType f ~ Text)
-              => FormFieldSettings -> Maybe Text -> f
-passwordField = requiredFieldHelper passwordFieldProfile
-
-maybePasswordField :: (IsForm f, FormType f ~ Maybe Text)
-                   => FormFieldSettings -> Maybe (Maybe Text) -> f
-maybePasswordField = optionalFieldHelper passwordFieldProfile
-
-intInput :: Integral i => Text -> FormInput sub master i
-intInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper intFieldProfile (nameSettings n) Nothing
-
-maybeIntInput :: Integral i => Text -> FormInput sub master (Maybe i)
-maybeIntInput n =
-    mapFormXml fieldsToInput $
-    optionalFieldHelper intFieldProfile (nameSettings n) Nothing
-
-intField :: (Integral (FormType f), IsForm f)
-         => FormFieldSettings -> Maybe (FormType f) -> f
-intField = requiredFieldHelper intFieldProfile
-
-maybeIntField :: (Integral i, FormType f ~ Maybe i, IsForm f)
-              => FormFieldSettings -> Maybe (FormType f) -> f
-maybeIntField = optionalFieldHelper intFieldProfile
-
-doubleField :: (IsForm f, FormType f ~ Double)
-            => FormFieldSettings -> Maybe Double -> f
-doubleField = requiredFieldHelper doubleFieldProfile
-
-maybeDoubleField :: (IsForm f, FormType f ~ Maybe Double)
-                 => FormFieldSettings -> Maybe (Maybe Double) -> f
-maybeDoubleField = optionalFieldHelper doubleFieldProfile
-
-dayField :: (IsForm f, FormType f ~ Day)
-         => FormFieldSettings -> Maybe Day -> f
-dayField = requiredFieldHelper dayFieldProfile
-
-maybeDayField :: (IsForm f, FormType f ~ Maybe Day)
-              => FormFieldSettings -> Maybe (Maybe Day) -> f
-maybeDayField = optionalFieldHelper dayFieldProfile
-
-timeField :: (IsForm f, FormType f ~ TimeOfDay)
-          => FormFieldSettings -> Maybe TimeOfDay -> f
-timeField = requiredFieldHelper timeFieldProfile
-
-maybeTimeField :: (IsForm f, FormType f ~ Maybe TimeOfDay)
-               => FormFieldSettings -> Maybe (Maybe TimeOfDay) -> f
-maybeTimeField = optionalFieldHelper timeFieldProfile
-
-boolField :: (IsForm f, FormType f ~ Bool)
-          => FormFieldSettings -> Maybe Bool -> f
-boolField ffs orig = toForm $ do
-    env <- askParams
-    let label = ffsLabel ffs
-        tooltip = ffsTooltip ffs
-    name <- maybe newFormIdent return $ ffsName ffs
-    theId <- maybe newFormIdent return $ ffsId ffs
-    let (res, val) =
-            if null env
-                then (FormMissing, fromMaybe False orig)
-                else case lookup name env of
-                        Nothing -> (FormSuccess False, False)
-                        Just "" -> (FormSuccess False, False)
-                        Just "false" -> (FormSuccess False, False)
-                        Just _ -> (FormSuccess True, True)
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = [HAMLET|
-<input id="#{theId}" type="checkbox" name="#{name}" :val:checked="">
-|]
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ toHtml x
-                            _ -> Nothing
-            , fiRequired = True
-            }
-    return (res, fi, UrlEncoded)
-
-htmlField :: (IsForm f, FormType f ~ Html)
-          => FormFieldSettings -> Maybe Html -> f
-htmlField = requiredFieldHelper htmlFieldProfile
-
-maybeHtmlField :: (IsForm f, FormType f ~ Maybe Html)
-               => FormFieldSettings -> Maybe (Maybe Html) -> f
-maybeHtmlField = optionalFieldHelper htmlFieldProfile
-
-selectField :: (Eq x, IsForm f, FormType f ~ x)
-            => [(x, Text)]
-            -> FormFieldSettings
-            -> Maybe x
-            -> f
-selectField pairs ffs initial = toForm $ do
-    env <- askParams
-    let label = ffsLabel ffs
-        tooltip = ffsTooltip ffs
-    theId <- maybe newFormIdent return $ ffsId ffs
-    name <- maybe newFormIdent return $ ffsName ffs
-    let pairs' = zip [1 :: Int ..] pairs
-    let res = case lookup name env of
-                Nothing -> FormMissing
-                Just "none" -> FormFailure ["Field is required"]
-                Just x ->
-                    case reads $ unpack 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 =
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-<select id="#{theId}" name="#{name}">
-    <option value="none">
-    $forall pair <- pairs'
-        <option value="#{show (fst pair)}" :isSelected (fst (snd pair)):selected="">#{snd (snd pair)}
-|]
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = input
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ toHtml x
-                            _ -> Nothing
-            , fiRequired = True
-            }
-    return (res, fi, UrlEncoded)
-
-maybeSelectField :: (Eq x, IsForm f, Maybe x ~ FormType f)
-                 => [(x, Text)]
-                 -> FormFieldSettings
-                 -> Maybe (FormType f)
-                 -> f
-maybeSelectField pairs ffs initial' = toForm $ do
-    env <- askParams
-    let initial = join initial'
-        label = ffsLabel ffs
-        tooltip = ffsTooltip ffs
-    theId <- maybe newFormIdent return $ ffsId ffs
-    name <- maybe newFormIdent return $ ffsName ffs
-    let pairs' = zip [1 :: Int ..] pairs
-    let res = case lookup name env of
-                Nothing -> FormMissing
-                Just "none" -> FormSuccess Nothing
-                Just x ->
-                    case reads $ unpack 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 =
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-<select id="#{theId}" name="#{name}">
-    <option value="none">
-    $forall pair <- pairs'
-        <option value="#{show (fst pair)}" :isSelected (fst (snd pair)):selected="">#{snd (snd pair)}
-|]
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = input
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ toHtml x
-                            _ -> Nothing
-            , fiRequired = False
-            }
-    return (res, fi, UrlEncoded)
-
-stringInput :: Text -> FormInput sub master Text
-stringInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper stringFieldProfile (nameSettings n) Nothing
-
-maybeStringInput :: Text -> FormInput sub master (Maybe Text)
-maybeStringInput n =
-    mapFormXml fieldsToInput $
-    optionalFieldHelper stringFieldProfile (nameSettings n) Nothing
-
-boolInput :: Text -> FormInput sub master Bool
-boolInput n = GForm $ do
-    env <- askParams
-    let res = case lookup n env of
-                Nothing -> FormSuccess False
-                Just "" -> FormSuccess False
-                Just "false" -> FormSuccess False
-                Just _ -> FormSuccess True
-    let xml = [HAMLET|
-    <input id="#{n}" type="checkbox" name="#{n}">
-|]
-    return (res, [xml], UrlEncoded)
-
-dayInput :: Text -> FormInput sub master Day
-dayInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper dayFieldProfile (nameSettings n) Nothing
-
-maybeDayInput :: Text -> FormInput sub master (Maybe Day)
-maybeDayInput n =
-    mapFormXml fieldsToInput $
-    optionalFieldHelper dayFieldProfile (nameSettings n) Nothing
-
-nameSettings :: Text -> FormFieldSettings
-nameSettings n = FormFieldSettings mempty mempty (Just n) (Just n)
-
-urlField :: (IsForm f, FormType f ~ Text)
-         => FormFieldSettings -> Maybe Text -> f
-urlField = requiredFieldHelper urlFieldProfile
-
-maybeUrlField :: (IsForm f, FormType f ~ Maybe Text)
-               => FormFieldSettings -> Maybe (Maybe Text) -> f
-maybeUrlField = optionalFieldHelper urlFieldProfile
-
-urlInput :: Text -> FormInput sub master Text
-urlInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper urlFieldProfile (nameSettings n) Nothing
-
-emailField :: (IsForm f, FormType f ~ Text)
-           => FormFieldSettings -> Maybe Text -> f
-emailField = requiredFieldHelper emailFieldProfile
-
-maybeEmailField :: (IsForm f, FormType f ~ Maybe Text)
-                => FormFieldSettings -> Maybe (Maybe Text) -> f
-maybeEmailField = optionalFieldHelper emailFieldProfile
-
-emailInput :: Text -> FormInput sub master Text
-emailInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper emailFieldProfile (nameSettings n) Nothing
-
-searchField :: (IsForm f, FormType f ~ Text)
-           => AutoFocus -> FormFieldSettings -> Maybe Text -> f
-searchField = requiredFieldHelper . searchFieldProfile
-
-maybeSearchField :: (IsForm f, FormType f ~ Maybe Text)
-                => AutoFocus -> FormFieldSettings -> Maybe (Maybe Text) -> f
-maybeSearchField = optionalFieldHelper . searchFieldProfile
-
-textareaField :: (IsForm f, FormType f ~ Textarea)
-              => FormFieldSettings -> Maybe Textarea -> f
-textareaField = requiredFieldHelper textareaFieldProfile
-
-maybeTextareaField :: FormFieldSettings -> FormletField sub y (Maybe Textarea)
-maybeTextareaField = optionalFieldHelper textareaFieldProfile
-
-hiddenField :: (IsForm f, FormType f ~ Text)
-            => FormFieldSettings -> Maybe Text -> f
-hiddenField = requiredFieldHelper hiddenFieldProfile
-
-maybeHiddenField :: (IsForm f, FormType f ~ Maybe Text)
-                 => FormFieldSettings -> Maybe (Maybe Text) -> f
-maybeHiddenField = optionalFieldHelper hiddenFieldProfile
-
-fileField :: (IsForm f, FormType f ~ FileInfo)
-          => FormFieldSettings -> f
-fileField ffs = toForm $ do
-    env <- lift ask
-    fenv <- lift $ lift ask
-    let (FormFieldSettings label tooltip theId' name') = ffs
-    name <- maybe newFormIdent return name'
-    theId <- maybe newFormIdent return theId'
-    let res =
-            if null env && null fenv
-                then FormMissing
-                else case lookup name fenv of
-                        Nothing -> FormFailure ["File is required"]
-                        Just x -> FormSuccess x
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = fileWidget theId name True
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ toHtml x
-                            _ -> Nothing
-            , fiRequired = True
-            }
-    let res' = case res of
-                FormFailure [e] -> FormFailure [T.concat [label, ": ", e]]
-                _ -> res
-    return (res', fi, Multipart)
-
-maybeFileField :: (IsForm f, FormType f ~ Maybe FileInfo)
-               => FormFieldSettings -> f
-maybeFileField ffs = toForm $ do
-    fenv <- lift $ lift ask
-    let (FormFieldSettings label tooltip theId' name') = ffs
-    name <- maybe newFormIdent return name'
-    theId <- maybe newFormIdent return theId'
-    let res = FormSuccess $ lookup name fenv
-    let fi = FieldInfo
-            { fiLabel = toHtml label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiInput = fileWidget theId name False
-            , fiErrors = Nothing
-            , fiRequired = True
-            }
-    return (res, fi, Multipart)
-
-fileWidget :: Text -> Text -> Bool -> GWidget s m ()
-fileWidget theId name isReq = [HAMLET|
-<input id="#{theId}" type="file" name="#{name}" :isReq:required="">
-|]
-
-radioField :: (Eq x, IsForm f, FormType f ~ x)
-           => [(x, Text)]
-           -> FormFieldSettings
-           -> Maybe x
-           -> f
-radioField pairs ffs initial = toForm $ do
-    env <- askParams
-    let label = ffsLabel ffs
-        tooltip = ffsTooltip ffs
-    theId <- maybe newFormIdent return $ ffsId ffs
-    name <- maybe newFormIdent return $ ffsName ffs
-    let pairs' = zip [1 :: Int ..] pairs
-    let res = case lookup name env of
-                Nothing -> FormMissing
-                Just "none" -> FormFailure ["Field is required"]
-                Just x ->
-                    case reads $ unpack 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|
-<div id="#{theId}">
-   $forall pair <- pairs'
-       <div>
-           <input id="#{theId}-#{show (fst pair)}" type="radio" name="#{name}" value="#{show (fst pair)}" :isSelected (fst (snd pair)):checked="">
-           <label for="#{name}-#{show (fst pair)}">#{snd (snd pair)}
-|]
-    let fi = FieldInfo
-           { fiLabel = toHtml label
-           , fiTooltip = tooltip
-           , fiIdent = theId
-           , fiInput = input
-           , fiErrors = case res of
-                           FormFailure [x] -> Just $ toHtml x
-                           _ -> Nothing
-           , fiRequired = True
-           }
-    return (res, fi, UrlEncoded)
-
-maybeRadioField
-    :: (Eq x, IsForm f, FormType f ~ Maybe x)
-    => [(x, Text)]
-    -> FormFieldSettings
-    -> Maybe (FormType f)
-    -> f
-maybeRadioField pairs ffs initial' = toForm $ do
-    env <- askParams
-    let initial = join initial'
-        label = ffsLabel ffs
-        tooltip = ffsTooltip ffs
-    theId <- maybe newFormIdent return $ ffsId ffs
-    name <- maybe newFormIdent return $ ffsName ffs
-    let pairs' = zip [1 :: Int ..] pairs
-    let res = case lookup name env of
-                Nothing -> FormMissing
-                Just "none" -> FormSuccess Nothing
-                Just x ->
-                    case reads $ unpack 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 isNone =
-            case res of
-                FormSuccess Nothing -> True
-                FormSuccess Just{} -> False
-                _ -> isNothing initial
-    let input =
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-<div id="#{theId}">
-   $forall pair <- pairs'
-       <div>
-           <input id="#{theId}-none" type="radio" name="#{name}" value="none" :isNone:checked="">None
-       <div>
-           <input id="#{theId}-#{show (fst pair)}" type="radio" name="#{name}" value="#{show (fst pair)}" :isSelected (fst (snd pair)):checked="">
-           <label for="#{name}-#{show (fst pair)}">#{snd (snd pair)}
-|]
-    let fi = FieldInfo
-           { fiLabel = toHtml label
-           , fiTooltip = tooltip
-           , fiIdent = theId
-           , fiInput = input
-           , fiErrors = case res of
-                           FormFailure [x] -> Just $ toHtml x
-                           _ -> Nothing
-           , fiRequired = False
-           }
-    return (res, fi, UrlEncoded)
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Yesod.Form.Fields
+    ( FormMessage (..)
+    , defaultFormMessage
+    , textField
+    , passwordField
+    , textareaField
+    , hiddenField
+    , intField
+    , dayField
+    , timeField
+    , htmlField
+    , emailField
+    , searchField
+    , selectField
+    , AutoFocus
+    , urlField
+    , doubleField
+    , parseDate
+    , parseTime
+    , Textarea (..)
+    , radioField
+    , boolField
+    ) where
+
+import Yesod.Form.Types
+import Yesod.Widget
+import Yesod.Message (RenderMessage)
+import Yesod.Handler (GGHandler)
+import Text.Hamlet hiding (renderHtml)
+import Text.Blaze (ToHtml (..))
+import Text.Cassius
+import Data.Time (Day, TimeOfDay(..))
+import qualified Text.Email.Validate as Email
+import Network.URI (parseURI)
+import Database.Persist (PersistField)
+import Text.HTML.SanitizeXSS (sanitizeBalance)
+import Control.Monad (when, unless)
+
+import qualified Blaze.ByteString.Builder.Html.Utf8 as B
+import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
+import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
+
+import Text.Blaze.Renderer.String (renderHtml)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import Data.Text (Text, unpack, pack)
+import qualified Data.Text.Read
+import Data.Monoid (mappend)
+import Text.Hamlet.NonPoly (html)
+
+#if __GLASGOW_HASKELL__ >= 700
+#define WHAMLET whamlet
+#define HAMLET hamlet
+#define CASSIUS cassius
+#define JULIUS julius
+#define HTML html
+#else
+#define WHAMLET $whamlet
+#define HAMLET $hamlet
+#define CASSIUS $cassius
+#define JULIUS $julius
+#define HTML $html
+#endif
+
+data FormMessage = MsgInvalidInteger Text
+                 | MsgInvalidNumber Text
+                 | MsgInvalidEntry Text
+                 | MsgInvalidUrl Text
+                 | MsgInvalidEmail Text
+                 | MsgInvalidTimeFormat
+                 | MsgInvalidHour Text
+                 | MsgInvalidMinute Text
+                 | MsgInvalidSecond Text
+                 | MsgInvalidDay
+                 | MsgCsrfWarning
+                 | MsgValueRequired
+                 | MsgInputNotFound Text
+                 | MsgSelectNone
+                 | MsgInvalidBool Text
+                 | MsgBoolYes
+                 | MsgBoolNo
+
+defaultFormMessage :: FormMessage -> Text
+defaultFormMessage (MsgInvalidInteger t) = "Invalid integer: " `mappend` t
+defaultFormMessage (MsgInvalidNumber t) = "Invalid number: " `mappend` t
+defaultFormMessage (MsgInvalidEntry t) = "Invalid entry: " `mappend` t
+defaultFormMessage MsgInvalidTimeFormat = "Invalid time, must be in HH:MM[:SS] format"
+defaultFormMessage MsgInvalidDay = "Invalid day, must be in YYYY-MM-DD format"
+defaultFormMessage (MsgInvalidUrl t) = "Invalid URL: " `mappend` t
+defaultFormMessage (MsgInvalidEmail t) = "Invalid e-mail address: " `mappend` t
+defaultFormMessage (MsgInvalidHour t) = "Invalid hour: " `mappend` t
+defaultFormMessage (MsgInvalidMinute t) = "Invalid minute: " `mappend` t
+defaultFormMessage (MsgInvalidSecond t) = "Invalid second: " `mappend` t
+defaultFormMessage MsgCsrfWarning = "As a protection against cross-site request forgery attacks, please confirm your form submission."
+defaultFormMessage MsgValueRequired = "Value is required"
+defaultFormMessage (MsgInputNotFound t) = "Input not found: " `mappend` t
+defaultFormMessage MsgSelectNone = "<None>"
+defaultFormMessage (MsgInvalidBool t) = "Invalid boolean: " `mappend` t
+defaultFormMessage MsgBoolYes = "Yes"
+defaultFormMessage MsgBoolNo = "No"
+
+blank :: (Text -> Either msg a) -> Maybe Text -> Either msg (Maybe a)
+blank _ Nothing = Right Nothing
+blank _ (Just "") = Right Nothing
+blank f (Just t) = either Left (Right . Just) $ f t
+
+intField :: (Monad monad, Integral i) => Field (GGWidget master monad ()) FormMessage i
+intField = Field
+    { fieldParse = blank $ \s ->
+        case Data.Text.Read.signed Data.Text.Read.decimal s of
+            Right (a, "") -> Right a
+            _ -> Left $ MsgInvalidInteger s
+    , fieldRender = pack . showI
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="number" :isReq:required="" value="#{val}">
+|]
+    }
+  where
+    showI x = show (fromIntegral x :: Integer)
+
+doubleField :: Monad monad => Field (GGWidget master monad ()) FormMessage Double
+doubleField = Field
+    { fieldParse = blank $ \s ->
+        case Data.Text.Read.double s of
+            Right (a, "") -> Right a
+            _ -> Left $ MsgInvalidNumber s
+    , fieldRender = pack . show
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}">
+|]
+    }
+
+dayField :: Monad monad => Field (GGWidget master monad ()) FormMessage Day
+dayField = Field
+    { fieldParse = blank $ parseDate . unpack
+    , fieldRender = pack . show
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
+|]
+    }
+
+timeField :: Monad monad => Field (GGWidget master monad ()) FormMessage TimeOfDay
+timeField = Field
+    { fieldParse = blank $ parseTime . unpack
+    , fieldRender = pack . show . roundFullSeconds
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
+|]
+    }
+  where
+    roundFullSeconds tod =
+        TimeOfDay (todHour tod) (todMin tod) fullSec
+      where
+        fullSec = fromInteger $ floor $ todSec tod
+
+htmlField :: Monad monad => Field (GGWidget master monad ()) FormMessage Html
+htmlField = Field
+    { fieldParse = blank $ Right . preEscapedString . sanitizeBalance . unpack -- FIXME make changes to xss-sanitize
+    , fieldRender = pack . renderHtml
+    , fieldView = \theId name val _isReq -> addHamlet
+        [HAMLET|\
+<textarea id="#{theId}" name="#{name}" .html>#{val}
+|]
+    }
+
+-- | A newtype wrapper around a 'String' that converts newlines to HTML
+-- br-tags.
+newtype Textarea = Textarea { unTextarea :: Text }
+    deriving (Show, Read, Eq, PersistField)
+instance ToHtml Textarea where
+    toHtml =
+        unsafeByteString
+        . S.concat
+        . L.toChunks
+        . toLazyByteString
+        . fromWriteList writeHtmlEscapedChar
+        . unpack
+        . unTextarea
+      where
+        -- Taken from blaze-builder and modified with newline handling.
+        writeHtmlEscapedChar '\n' = writeByteString "<br>"
+        writeHtmlEscapedChar c    = B.writeHtmlEscapedChar c
+
+textareaField :: Monad monad => Field (GGWidget master monad ()) FormMessage Textarea
+textareaField = Field
+    { fieldParse = blank $ Right . Textarea
+    , fieldRender = unTextarea
+    , fieldView = \theId name val _isReq -> addHamlet
+        [HAMLET|\
+<textarea id="#{theId}" name="#{name}">#{val}
+|]
+    }
+
+hiddenField :: Monad monad => Field (GGWidget master monad ()) FormMessage Text
+hiddenField = Field
+    { fieldParse = blank $ Right
+    , fieldRender = id
+    , fieldView = \theId name val _isReq -> addHamlet
+        [HAMLET|\
+<input type="hidden" id="#{theId}" name="#{name}" value="#{val}">
+|]
+    }
+
+textField :: Monad monad => Field (GGWidget master monad ()) FormMessage Text
+textField = Field
+    { fieldParse = blank $ Right
+    , fieldRender = id
+    , fieldView = \theId name val isReq ->
+        [WHAMLET|
+<input id="#{theId}" name="#{name}" type="text" :isReq:required value="#{val}">
+|]
+    }
+
+passwordField :: Monad monad => Field (GGWidget master monad ()) FormMessage Text
+passwordField = Field
+    { fieldParse = blank $ Right
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="password" :isReq:required="" value="#{val}">
+|]
+    }
+
+readMay :: Read a => String -> Maybe a
+readMay s = case reads s of
+                (x, _):_ -> Just x
+                [] -> Nothing
+
+parseDate :: String -> Either FormMessage Day
+parseDate = maybe (Left MsgInvalidDay) Right
+              . readMay . replace '/' '-'
+
+-- | Replaces all instances of a value in a list by another value.
+-- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
+replace :: Eq a => a -> a -> [a] -> [a]
+replace x y = map (\z -> if z == x then y else z)
+
+parseTime :: String -> Either FormMessage TimeOfDay
+parseTime (h2:':':m1:m2:[]) = parseTimeHelper ('0', h2, m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:[]) = parseTimeHelper (h1, h2, m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:' ':'A':'M':[]) =
+    parseTimeHelper (h1, h2, m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:' ':'P':'M':[]) =
+    let [h1', h2'] = show $ (read [h1, h2] :: Int) + 12
+    in parseTimeHelper (h1', h2', m1, m2, '0', '0')
+parseTime (h1:h2:':':m1:m2:':':s1:s2:[]) =
+    parseTimeHelper (h1, h2, m1, m2, s1, s2)
+parseTime _ = Left MsgInvalidTimeFormat
+
+parseTimeHelper :: (Char, Char, Char, Char, Char, Char)
+                -> Either FormMessage TimeOfDay
+parseTimeHelper (h1, h2, m1, m2, s1, s2)
+    | h < 0 || h > 23 = Left $ MsgInvalidHour $ pack [h1, h2]
+    | m < 0 || m > 59 = Left $ MsgInvalidMinute $ pack [m1, m2]
+    | s < 0 || s > 59 = Left $ MsgInvalidSecond $ pack [s1, s2]
+    | otherwise = Right $ TimeOfDay h m s
+  where
+    h = read [h1, h2] -- FIXME isn't this a really bad idea?
+    m = read [m1, m2]
+    s = fromInteger $ read [s1, s2]
+
+emailField :: Monad monad => Field (GGWidget master monad ()) FormMessage Text
+emailField = Field
+    { fieldParse = blank $
+        \s -> if Email.isValid (unpack s)
+                then Right s
+                else Left $ MsgInvalidEmail s
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="email" :isReq:required="" value="#{val}">
+|]
+    }
+
+type AutoFocus = Bool
+searchField :: Monad monad => AutoFocus -> Field (GGWidget master monad ()) FormMessage Text
+searchField autoFocus = Field
+    { fieldParse = blank Right
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> do
+        addHtml [HAMLET|\
+<input id="#{theId}" name="#{name}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{val}">
+|]
+        when autoFocus $ do
+          addHtml $ [HAMLET|\<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}</script> 
+|]
+          addCassius [CASSIUS|
+            #{theId}
+              -webkit-appearance: textfield
+            |]
+    }
+
+urlField :: Monad monad => Field (GGWidget master monad ()) FormMessage Text
+urlField = Field
+    { fieldParse = blank $ \s ->
+        case parseURI $ unpack s of
+            Nothing -> Left $ MsgInvalidUrl s
+            Just _ -> Right s
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> addHtml
+        [HAMLET|
+<input ##{theId} name=#{name} type=url :isReq:required value=#{val}>
+|]
+    }
+
+selectField :: (Eq a, Monad monad, RenderMessage master FormMessage) => [(Text, a)] -> Field (GGWidget master (GGHandler sub master monad) ()) FormMessage a
+selectField = selectFieldHelper
+    (\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|])
+    (\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|])
+    (\_theId _name value isSel text -> addHtml [HTML|<option value=#{value} :isSel:selected>#{text}|])
+
+radioField :: (Eq a, Monad monad, RenderMessage master FormMessage) => [(Text, a)] -> Field (GGWidget master (GGHandler sub master monad) ()) FormMessage a
+radioField = selectFieldHelper
+    (\theId _name inside -> [WHAMLET|<div ##{theId}>^{inside}|])
+    (\theId name isSel -> [WHAMLET|
+<div>
+    <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
+    <label for=#{theId}-none>_{MsgSelectNone}
+|])
+    (\theId name value isSel text -> [WHAMLET|
+<div>
+    <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked>
+    <label for=#{theId}-#{value}>#{text}
+|])
+
+boolField :: (Monad monad, RenderMessage master FormMessage) => Field (GGWidget master (GGHandler sub master monad) ()) FormMessage Bool
+boolField = Field
+    { fieldParse = \s ->
+        case s of
+            Nothing -> Right Nothing
+            Just "" -> Right Nothing
+            Just "none" -> Right Nothing
+            Just "yes" -> Right $ Just True
+            Just "no" -> Right $ Just False
+            Just t -> Left $ MsgInvalidBool t
+    , fieldRender = \a -> if a then "yes" else "no"
+    , fieldView = \theId name val isReq -> [WHAMLET|
+$if not isReq
+    <input id=#{theId}-none type=radio name=#{name} value=none :isNone val:checked>
+    <label for=#{theId}-none>_{MsgSelectNone}
+
+<input id=#{theId}-yes type=radio name=#{name} value=yes :(==) val "yes":checked>
+<label for=#{theId}-yes>_{MsgBoolYes}
+
+<input id=#{theId}-no type=radio name=#{name} value=no :(==) val "no":checked>
+<label for=#{theId}-no>_{MsgBoolNo}
+|]
+    }
+  where
+    isNone val = not $ val `elem` ["yes", "no"]
+
+selectFieldHelper :: (Eq a, Monad monad)
+        => (Text -> Text -> GGWidget master monad () -> GGWidget master monad ())
+        -> (Text -> Text -> Bool -> GGWidget master monad ())
+        -> (Text -> Text -> Text -> Bool -> Text -> GGWidget master monad ())
+        -> [(Text, a)] -> Field (GGWidget master monad ()) FormMessage a
+selectFieldHelper outside onOpt inside opts = Field
+    { fieldParse = \s ->
+        case s of
+            Nothing -> Right Nothing
+            Just "" -> Right Nothing
+            Just "none" -> Right Nothing
+            Just x ->
+                case Data.Text.Read.decimal x of
+                    Right (a, "") ->
+                        case lookup a pairs of
+                            Nothing -> Left $ MsgInvalidEntry x
+                            Just y -> Right $ Just $ snd y
+                    _ -> Left $ MsgInvalidNumber x
+    , fieldRender = \a -> maybe "" (pack . show) $ lookup a rpairs
+    , fieldView = \theId name val isReq ->
+        outside theId name $ do
+            unless isReq $ onOpt theId name $ not $ val `elem` map (pack . show . fst) pairs
+            flip mapM_ pairs $ \pair -> inside
+                theId
+                name
+                (pack $ show $ fst pair)
+                (val == pack (show $ fst pair))
+                (fst $ snd pair)
+    }
+  where
+    pairs = zip [1 :: Int ..] opts -- FIXME use IntMap
+    rpairs = zip (map snd opts) [1 :: Int ..]
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Functions.hs
@@ -0,0 +1,234 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Yesod.Form.Functions
+    ( -- * Running in Form monad
+      newFormIdent
+    , askParams
+    , askFiles
+      -- * Applicative/Monadic conversion
+    , formToAForm
+    , aFormToForm
+      -- * Fields to Forms
+    , mreq
+    , mopt
+    , areq
+    , aopt
+      -- * Run a form
+    , runFormPost
+    , runFormPostNoNonce
+    , runFormGet
+      -- * Rendering
+    , FormRender
+    , renderTable
+    , renderDivs
+    ) where
+
+import Yesod.Form.Types
+import Yesod.Form.Fields (FormMessage (MsgCsrfWarning, MsgValueRequired))
+import Data.Text (Text, pack)
+import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad (liftM, join)
+import Text.Blaze (Html, toHtml)
+import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody, newIdent, getYesod)
+import Yesod.Core (RenderMessage)
+import Yesod.Widget (GGWidget, whamlet)
+import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages)
+import Network.Wai (requestMethod)
+import Text.Hamlet.NonPoly (html)
+import Data.Monoid (mempty)
+import Data.Maybe (fromMaybe)
+import Yesod.Message (RenderMessage (..))
+
+#if __GLASGOW_HASKELL__ >= 700
+#define WHAMLET whamlet
+#define HTML html
+#else
+#define HTML $html
+#define WHAMLET $whamlet
+#endif
+
+-- | Get a unique identifier.
+newFormIdent :: Monad m => Form msg m Text
+newFormIdent = do
+    i <- get
+    let i' = incrInts i
+    put i'
+    return $ pack $ 'f' : show i'
+  where
+    incrInts (IntSingle i) = IntSingle $ i + 1
+    incrInts (IntCons i is) = (i + 1) `IntCons` is
+
+formToAForm :: Monad m => Form msg m (FormResult a, xml) -> AForm ([xml] -> [xml]) msg m a
+formToAForm form = AForm $ \(master, langs) env ints -> do
+    ((a, xml), ints', enc) <- runRWST form (env, master, langs) ints
+    return (a, (:) xml, ints', enc)
+
+aFormToForm :: Monad m => AForm xml msg m a -> Form msg m (FormResult a, xml)
+aFormToForm (AForm aform) = do
+    ints <- get
+    (env, master, langs) <- ask
+    (a, xml, ints', enc) <- lift $ aform (master, langs) env ints
+    put ints'
+    tell enc
+    return (a, xml)
+
+askParams :: Monad m => Form msg m (Maybe Env)
+askParams = do
+    (x, _, _) <- ask
+    return $ liftM fst x
+
+askFiles :: Monad m => Form msg m (Maybe FileEnv)
+askFiles = do
+    (x, _, _) <- ask
+    return $ liftM snd x
+
+mreq :: (Monad m, RenderMessage master msg, RenderMessage master msg2, RenderMessage master FormMessage)
+     => Field xml msg a -> FieldSettings msg2 -> Maybe a
+     -> Form master (GGHandler sub master m) (FormResult a, FieldView xml)
+mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True
+
+mopt :: (Monad m, RenderMessage master msg, RenderMessage master msg2)
+     => Field xml msg a -> FieldSettings msg2 -> Maybe (Maybe a)
+     -> Form master (GGHandler sub master m) (FormResult (Maybe a), FieldView xml)
+mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False
+
+mhelper :: (Monad m, RenderMessage master msg, RenderMessage master msg2)
+        => Field xml msg a
+        -> FieldSettings msg2
+        -> Maybe a
+        -> (master -> [Text] -> FormResult b) -- ^ on missing
+        -> (a -> FormResult b) -- ^ on success
+        -> Bool -- ^ is it required?
+        -> Form master (GGHandler sub master m) (FormResult b, FieldView xml)
+mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
+    mp <- askParams
+    name <- maybe newFormIdent return fsName
+    theId <- lift $ maybe (liftM pack newIdent) return fsId
+    (_, master, langs) <- ask
+    let mr2 = renderMessage master langs
+    let (res, val) =
+            case mp of
+                Nothing -> (FormMissing, maybe "" fieldRender mdef)
+                Just p ->
+                    let mval = lookup name p
+                        valB = fromMaybe "" mval
+                     in case fieldParse mval of
+                            Left e -> (FormFailure [renderMessage master langs e], valB)
+                            Right mx ->
+                                case mx of
+                                    Nothing -> (onMissing master langs, valB)
+                                    Just x -> (onFound x, valB)
+    return (res, FieldView
+        { fvLabel = toHtml $ mr2 fsLabel
+        , fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
+        , fvId = theId
+        , fvInput = fieldView theId name val isReq
+        , fvErrors =
+            case res of
+                FormFailure [e] -> Just $ toHtml e
+                _ -> Nothing
+        , fvRequired = isReq
+        })
+
+areq :: (Monad m, RenderMessage master msg1, RenderMessage master msg2, RenderMessage master FormMessage)
+     => Field xml msg1 a -> FieldSettings msg2 -> Maybe a
+     -> AForm ([FieldView xml] -> [FieldView xml]) master (GGHandler sub master m) a
+areq a b = formToAForm . mreq a b
+
+aopt :: (Monad m, RenderMessage master msg1, RenderMessage master msg2)
+     => Field xml msg1 a -> FieldSettings msg2 -> Maybe (Maybe a)
+     -> AForm ([FieldView xml] -> [FieldView xml]) master (GGHandler sub master m) (Maybe a)
+aopt a b = formToAForm . mopt a b
+
+runFormGeneric :: Monad m => Form master m a -> master -> [Text] -> Maybe (Env, FileEnv) -> m (a, Enctype)
+runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSingle 1)
+
+runFormPost :: RenderMessage master FormMessage
+            => (Html -> Form master (GHandler sub master) (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
+runFormPost form = do
+    req <- getRequest
+    let nonceKey = "_nonce"
+    let nonce =
+            case reqNonce req of
+                Nothing -> mempty
+                Just n -> [HTML|<input type=hidden name=#{nonceKey} value=#{n}>|]
+    env <- if requestMethod (reqWaiRequest req) == "GET"
+                then return Nothing
+                else fmap Just runRequestBody
+    m <- getYesod
+    langs <- languages
+    ((res, xml), enctype) <- runFormGeneric (form nonce) m langs env
+    let res' =
+            case (res, env) of
+                (FormSuccess{}, Just (params, _))
+                    | lookup nonceKey params /= reqNonce req ->
+                        FormFailure [renderMessage m langs MsgCsrfWarning]
+                _ -> res
+    return ((res', xml), enctype)
+
+runFormPostNoNonce :: (Html -> Form master (GHandler sub master) (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
+runFormPostNoNonce form = do
+    req <- getRequest
+    env <- if requestMethod (reqWaiRequest req) == "GET"
+                then return Nothing
+                else fmap Just runRequestBody
+    langs <- languages
+    m <- getYesod
+    runFormGeneric (form mempty) m langs env
+
+runFormGet :: Monad m => (Html -> Form master (GGHandler sub master m) a) -> GGHandler sub master m (a, Enctype)
+runFormGet form = do
+    let key = "_hasdata"
+    let fragment = [HTML|<input type=hidden name=#{key}>|]
+    gets <- liftM reqGetParams getRequest
+    let env =
+            case lookup key gets of
+                Nothing -> Nothing
+                Just _ -> Just (gets, [])
+    langs <- languages
+    m <- getYesod
+    runFormGeneric (form fragment) m langs env
+
+type FormRender master msg m a =
+       AForm ([FieldView (GGWidget master m ())] -> [FieldView (GGWidget master m ())]) msg m a
+    -> Html
+    -> Form msg m (FormResult a, GGWidget master m ())
+
+renderTable, renderDivs :: Monad m => FormRender master msg m a
+renderTable aform fragment = do
+    (res, views') <- aFormToForm aform
+    let views = views' []
+    -- FIXME non-valid HTML
+    let widget = [WHAMLET|
+\#{fragment}
+$forall view <- views
+    <tr :fvRequired view:.required :not $ fvRequired view:.optional>
+        <td>
+            <label for=#{fvId view}>#{fvLabel view}
+            $maybe tt <- fvTooltip view
+                <div .tooltip>#{tt}
+        <td>^{fvInput view}
+        $maybe err <- fvErrors view
+            <td .errors>#{err}
+|]
+    return (res, widget)
+
+renderDivs aform fragment = do
+    (res, views') <- aFormToForm aform
+    let views = views' []
+    let widget = [WHAMLET|
+\#{fragment}
+$forall view <- views
+    <div :fvRequired view:.required :not $ fvRequired view:.optional>
+        <label for=#{fvId view}>#{fvLabel view}
+        $maybe tt <- fvTooltip view
+            <div .tooltip>#{tt}
+        ^{fvInput view}
+        $maybe err <- fvErrors view
+            <div .errors>#{err}
+|]
+    return (res, widget)
diff --git a/Yesod/Form/Input.hs b/Yesod/Form/Input.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Input.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Yesod.Form.Input
+    ( FormInput (..)
+    , runInputGet
+    , runInputPost
+    , ireq
+    , iopt
+    ) where
+
+import Yesod.Form.Types
+import Yesod.Form.Fields (FormMessage (MsgInputNotFound))
+import Data.Text (Text)
+import Control.Applicative (Applicative (..))
+import Yesod.Handler (GHandler, GGHandler, invalidArgs, runRequestBody, getRequest, getYesod)
+import Yesod.Request (reqGetParams, languages)
+import Control.Monad (liftM)
+import Yesod.Widget (GWidget)
+import Yesod.Message (RenderMessage (..))
+
+type DText = [Text] -> [Text]
+newtype FormInput master a = FormInput { unFormInput :: master -> [Text] -> Env -> Either DText a }
+instance Functor (FormInput master) where
+    fmap a (FormInput f) = FormInput $ \c d e -> either Left (Right . a) $ f c d e
+instance Applicative (FormInput master) where
+    pure = FormInput . const . const . const . Right
+    (FormInput f) <*> (FormInput x) = FormInput $ \c d e ->
+        case (f c d e, x c d e) of
+            (Left a, Left b) -> Left $ a . b
+            (Left a, _) -> Left a
+            (_, Left b) -> Left b
+            (Right a, Right b) -> Right $ a b
+
+ireq :: (RenderMessage master msg, RenderMessage master FormMessage) => Field (GWidget sub master ()) msg a -> Text -> FormInput master a
+ireq field name = FormInput $ \m l env ->
+    case fieldParse field $ lookup name env of
+        Left e -> Left $ (:) $ renderMessage m l e
+        Right Nothing -> Left $ (:) $ renderMessage m l $ MsgInputNotFound name
+        Right (Just a) -> Right a
+
+iopt :: RenderMessage master msg => Field (GWidget sub master ()) msg a -> Text -> FormInput master (Maybe a)
+iopt field name = FormInput $ \m l env ->
+    case fieldParse field $ lookup name env of
+        Left e -> Left $ (:) $ renderMessage m l e
+        Right x -> Right x
+
+runInputGet :: Monad monad => FormInput master a -> GGHandler sub master monad a
+runInputGet (FormInput f) = do
+    env <- liftM reqGetParams getRequest
+    m <- getYesod
+    l <- languages
+    case f m l env of
+        Left errs -> invalidArgs $ errs []
+        Right x -> return x
+
+runInputPost :: FormInput master a -> GHandler sub master a
+runInputPost (FormInput f) = do
+    env <- liftM fst runRequestBody
+    m <- getYesod
+    l <- languages
+    case f m l env of
+        Left errs -> invalidArgs $ errs []
+        Right x -> return x
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
--- a/Yesod/Form/Jquery.hs
+++ b/Yesod/Form/Jquery.hs
@@ -1,241 +1,202 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
--- | Some fields spiced up with jQuery UI.
-module Yesod.Form.Jquery
-    ( YesodJquery (..)
-    , jqueryDayField
-    , maybeJqueryDayField
-    , jqueryDayTimeField
-    , jqueryDayTimeFieldProfile
-    , jqueryAutocompleteField
-    , maybeJqueryAutocompleteField
-    , jqueryDayFieldProfile
-    , googleHostedJqueryUiCss
-    , JqueryDaySettings (..)
-    , Default (..)
-    ) where
-
-import Yesod.Handler
-import Yesod.Form.Core
-import Yesod.Form.Profiles
-import Yesod.Widget
-import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
-                  timeToTimeOfDay)
-import Data.Char (isSpace)
-import Data.Default
-import Text.Hamlet (hamlet)
-import Text.Julius (julius)
-import Control.Monad.Trans.Class (lift)
-import Data.Text (Text, pack, unpack)
-import Data.Monoid (mconcat)
-
-#if __GLASGOW_HASKELL__ >= 700
-#define HAMLET hamlet
-#define CASSIUS cassius
-#define JULIUS julius
-#else
-#define HAMLET $hamlet
-#define CASSIUS $cassius
-#define JULIUS $julius
-#endif
-
--- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
-googleHostedJqueryUiCss :: Text -> Text
-googleHostedJqueryUiCss theme = mconcat
-    [ "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/"
-    , theme
-    , "/jquery-ui.css"
-    ]
-
-class YesodJquery a where
-    -- | The jQuery 1.4 Javascript file.
-    urlJqueryJs :: a -> Either (Route a) Text
-    urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4/jquery.min.js"
-
-    -- | The jQuery UI 1.8 Javascript file.
-    urlJqueryUiJs :: a -> Either (Route a) Text
-    urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/jquery-ui.min.js"
-
-    -- | The jQuery UI 1.8 CSS file; defaults to cupertino theme.
-    urlJqueryUiCss :: a -> Either (Route a) Text
-    urlJqueryUiCss _ = Right $ googleHostedJqueryUiCss "cupertino"
-
-    -- | jQuery UI time picker add-on.
-    urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
-    urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
-
-jqueryDayField :: (IsForm f, FormType f ~ Day, YesodJquery (FormMaster f))
-               => JqueryDaySettings
-               -> FormFieldSettings
-               -> Maybe (FormType f)
-               -> f
-jqueryDayField = requiredFieldHelper . jqueryDayFieldProfile
-
-maybeJqueryDayField
-    :: (IsForm f, FormType f ~ Maybe Day, YesodJquery (FormMaster f))
-    => JqueryDaySettings
-    -> FormFieldSettings
-    -> Maybe (FormType f)
-    -> f
-maybeJqueryDayField = optionalFieldHelper . jqueryDayFieldProfile
-
-jqueryDayFieldProfile :: YesodJquery y
-                      => JqueryDaySettings -> FieldProfile sub y Day
-jqueryDayFieldProfile jds = FieldProfile
-    { fpParse = maybe
-                  (Left "Invalid day, must be in YYYY-MM-DD format")
-                  Right
-              . readMay
-              . unpack
-    , fpRender = pack . show
-    , fpWidget = \theId name val isReq -> do
-        addHtml [HAMLET|\
-<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
-|]
-        addScript' urlJqueryJs
-        addScript' urlJqueryUiJs
-        addStylesheet' urlJqueryUiCss
-        addJulius [JULIUS|
-$(function(){$("##{theId}").datepicker({
-    dateFormat:'yy-mm-dd',
-    changeMonth:#{jsBool $ jdsChangeMonth jds},
-    changeYear:#{jsBool $ jdsChangeYear jds},
-    numberOfMonths:#{mos $ jdsNumberOfMonths jds},
-    yearRange:"#{jdsYearRange jds}"
-})});
-|]
-    }
-  where
-    jsBool True = "true" :: Text
-    jsBool False = "false" :: Text
-    mos (Left i) = show i
-    mos (Right (x, y)) = concat
-        [ "["
-        , show x
-        , ","
-        , show y
-        , "]"
-        ]
-
-ifRight :: Either a b -> (b -> c) -> Either a c
-ifRight e f = case e of
-            Left l  -> Left l
-            Right r -> Right $ f r
-
-showLeadingZero :: (Show a) => a -> String
-showLeadingZero time = let t = show time in if length t == 1 then "0" ++ t else t
-
-jqueryDayTimeField
-    :: (IsForm f, FormType f ~ UTCTime, YesodJquery (FormMaster f))
-    => FormFieldSettings
-    -> Maybe (FormType f)
-    -> f
-jqueryDayTimeField = requiredFieldHelper jqueryDayTimeFieldProfile
-
--- use A.M/P.M and drop seconds and "UTC" (as opposed to normal UTCTime show)
-jqueryDayTimeUTCTime :: UTCTime -> String
-jqueryDayTimeUTCTime (UTCTime day utcTime) =
-  let timeOfDay = timeToTimeOfDay utcTime
-  in (replace '-' '/' (show day)) ++ " " ++ showTimeOfDay timeOfDay
-  where
-    showTimeOfDay (TimeOfDay hour minute _) =
-      let (h, apm) = if hour < 12 then (hour, "AM") else (hour - 12, "PM")
-      in (show h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
-
-jqueryDayTimeFieldProfile :: YesodJquery y => FieldProfile sub y UTCTime
-jqueryDayTimeFieldProfile = FieldProfile
-    { fpParse  = parseUTCTime . unpack
-    , fpRender = pack . jqueryDayTimeUTCTime
-    , fpWidget = \theId name val isReq -> do
-        addHtml [HAMLET|\
-<input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
-|]
-        addScript' urlJqueryJs
-        addScript' urlJqueryUiJs
-        addScript' urlJqueryUiDateTimePicker
-        addStylesheet' urlJqueryUiCss
-        addJulius [JULIUS|
-$(function(){$("##{theId}").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})});
-|]
-    }
-
-parseUTCTime :: String -> Either Text UTCTime
-parseUTCTime s =
-    let (dateS, timeS) = break isSpace (dropWhile isSpace s)
-        dateE = parseDate dateS
-     in case dateE of
-            Left l -> Left l
-            Right date ->
-                ifRight (parseTime timeS)
-                    (UTCTime date . timeOfDayToTime)
-
-jqueryAutocompleteField
-    :: (IsForm f, FormType f ~ Text, YesodJquery (FormMaster f))
-    => Route (FormMaster f)
-    -> FormFieldSettings
-    -> Maybe (FormType f)
-    -> f
-jqueryAutocompleteField = requiredFieldHelper . jqueryAutocompleteFieldProfile
-
-maybeJqueryAutocompleteField
-    :: (IsForm f, FormType f ~ Maybe Text, YesodJquery (FormMaster f))
-    => Route (FormMaster f)
-    -> FormFieldSettings
-    -> Maybe (FormType f)
-    -> f
-maybeJqueryAutocompleteField src =
-    optionalFieldHelper $ jqueryAutocompleteFieldProfile src
-
-jqueryAutocompleteFieldProfile :: YesodJquery y => Route y -> FieldProfile sub y Text
-jqueryAutocompleteFieldProfile src = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> do
-        addHtml [HAMLET|\
-<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}" .autocomplete>
-|]
-        addScript' urlJqueryJs
-        addScript' urlJqueryUiJs
-        addStylesheet' urlJqueryUiCss
-        addJulius [JULIUS|
-$(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
-|]
-    }
-
-addScript' :: (y -> Either (Route y) Text) -> GWidget sub y ()
-addScript' f = do
-    y <- lift getYesod
-    addScriptEither $ f y
-
-addStylesheet' :: (y -> Either (Route y) Text) -> GWidget sub y ()
-addStylesheet' f = do
-    y <- lift getYesod
-    addStylesheetEither $ f y
-
-readMay :: Read a => String -> Maybe a
-readMay s = case reads s of
-                (x, _):_ -> Just x
-                [] -> Nothing
-
--- | Replaces all instances of a value in a list by another value.
--- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
-replace :: Eq a => a -> a -> [a] -> [a]
-replace x y = map (\z -> if z == x then y else z)
-
-data JqueryDaySettings = JqueryDaySettings
-    { jdsChangeMonth :: Bool
-    , jdsChangeYear :: Bool
-    , jdsYearRange :: String
-    , jdsNumberOfMonths :: Either Int (Int, Int)
-    }
-
-instance Default JqueryDaySettings where
-    def = JqueryDaySettings
-        { jdsChangeMonth = False
-        , jdsChangeYear = False
-        , jdsYearRange = "c-10:c+10"
-        , jdsNumberOfMonths = Left 1
-        }
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove
+-- | Some fields spiced up with jQuery UI.
+module Yesod.Form.Jquery
+    ( YesodJquery (..)
+    , jqueryDayField
+    , jqueryDayTimeField
+    , jqueryAutocompleteField
+    , googleHostedJqueryUiCss
+    , JqueryDaySettings (..)
+    , Default (..)
+    ) where
+
+import Yesod.Handler
+import Yesod.Form
+import Yesod.Widget
+import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
+                  timeToTimeOfDay)
+import Data.Char (isSpace)
+import Data.Default
+import Text.Hamlet (hamlet)
+import Text.Julius (julius)
+import Control.Monad.Trans.Class (lift)
+import Data.Text (Text, pack, unpack)
+import Data.Monoid (mconcat)
+
+#if __GLASGOW_HASKELL__ >= 700
+#define HAMLET hamlet
+#define CASSIUS cassius
+#define JULIUS julius
+#else
+#define HAMLET $hamlet
+#define CASSIUS $cassius
+#define JULIUS $julius
+#endif
+
+-- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
+googleHostedJqueryUiCss :: Text -> Text
+googleHostedJqueryUiCss theme = mconcat
+    [ "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/"
+    , theme
+    , "/jquery-ui.css"
+    ]
+
+class YesodJquery a where
+    -- | The jQuery 1.4 Javascript file.
+    urlJqueryJs :: a -> Either (Route a) Text
+    urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4/jquery.min.js"
+
+    -- | The jQuery UI 1.8 Javascript file.
+    urlJqueryUiJs :: a -> Either (Route a) Text
+    urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/jquery-ui.min.js"
+
+    -- | The jQuery UI 1.8 CSS file; defaults to cupertino theme.
+    urlJqueryUiCss :: a -> Either (Route a) Text
+    urlJqueryUiCss _ = Right $ googleHostedJqueryUiCss "cupertino"
+
+    -- | jQuery UI time picker add-on.
+    urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
+    urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
+
+blank :: (Text -> Either msg a) -> Maybe Text -> Either msg (Maybe a)
+blank _ Nothing = Right Nothing
+blank _ (Just "") = Right Nothing
+blank f (Just t) = either Left (Right . Just) $ f t
+
+jqueryDayField :: (YesodJquery master) => JqueryDaySettings -> Field (GWidget sub master ()) FormMessage Day
+jqueryDayField jds = Field
+    { fieldParse = blank $ maybe
+                  (Left MsgInvalidDay)
+                  Right
+              . readMay
+              . unpack
+    , fieldRender = pack . show
+    , fieldView = \theId name val isReq -> do
+        addHtml [HAMLET|\
+<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
+|]
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addStylesheet' urlJqueryUiCss
+        addJulius [JULIUS|
+$(function(){$("##{theId}").datepicker({
+    dateFormat:'yy-mm-dd',
+    changeMonth:#{jsBool $ jdsChangeMonth jds},
+    changeYear:#{jsBool $ jdsChangeYear jds},
+    numberOfMonths:#{mos $ jdsNumberOfMonths jds},
+    yearRange:"#{jdsYearRange jds}"
+})});
+|]
+    }
+  where
+    jsBool True = "true" :: Text
+    jsBool False = "false" :: Text
+    mos (Left i) = show i
+    mos (Right (x, y)) = concat
+        [ "["
+        , show x
+        , ","
+        , show y
+        , "]"
+        ]
+
+ifRight :: Either a b -> (b -> c) -> Either a c
+ifRight e f = case e of
+            Left l  -> Left l
+            Right r -> Right $ f r
+
+showLeadingZero :: (Show a) => a -> String
+showLeadingZero time = let t = show time in if length t == 1 then "0" ++ t else t
+
+-- use A.M/P.M and drop seconds and "UTC" (as opposed to normal UTCTime show)
+jqueryDayTimeUTCTime :: UTCTime -> String
+jqueryDayTimeUTCTime (UTCTime day utcTime) =
+  let timeOfDay = timeToTimeOfDay utcTime
+  in (replace '-' '/' (show day)) ++ " " ++ showTimeOfDay timeOfDay
+  where
+    showTimeOfDay (TimeOfDay hour minute _) =
+      let (h, apm) = if hour < 12 then (hour, "AM") else (hour - 12, "PM")
+      in (show h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
+
+jqueryDayTimeField :: YesodJquery master => Field (GWidget sub master ()) FormMessage UTCTime
+jqueryDayTimeField = Field
+    { fieldParse  = blank $ parseUTCTime . unpack
+    , fieldRender = pack . jqueryDayTimeUTCTime
+    , fieldView = \theId name val isReq -> do
+        addHtml [HAMLET|\
+<input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
+|]
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addScript' urlJqueryUiDateTimePicker
+        addStylesheet' urlJqueryUiCss
+        addJulius [JULIUS|
+$(function(){$("##{theId}").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})});
+|]
+    }
+
+parseUTCTime :: String -> Either FormMessage UTCTime
+parseUTCTime s =
+    let (dateS, timeS) = break isSpace (dropWhile isSpace s)
+        dateE = parseDate dateS
+     in case dateE of
+            Left l -> Left l
+            Right date ->
+                ifRight (parseTime timeS)
+                    (UTCTime date . timeOfDayToTime)
+
+jqueryAutocompleteField :: YesodJquery master => Route master -> Field (GWidget sub master ()) FormMessage Text
+jqueryAutocompleteField src = Field
+    { fieldParse = Right
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> do
+        addHtml [HAMLET|\
+<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}" .autocomplete>
+|]
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addStylesheet' urlJqueryUiCss
+        addJulius [JULIUS|
+$(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
+|]
+    }
+
+addScript' :: Monad m => (t -> Either (Route master) Text) -> GGWidget master (GGHandler sub t m) ()
+addScript' f = do
+    y <- lift getYesod
+    addScriptEither $ f y
+
+addStylesheet' :: (y -> Either (Route y) Text) -> GWidget sub y ()
+addStylesheet' f = do
+    y <- lift getYesod
+    addStylesheetEither $ f y
+
+readMay :: Read a => String -> Maybe a
+readMay s = case reads s of
+                (x, _):_ -> Just x
+                [] -> Nothing
+
+-- | Replaces all instances of a value in a list by another value.
+-- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
+replace :: Eq a => a -> a -> [a] -> [a]
+replace x y = map (\z -> if z == x then y else z)
+
+data JqueryDaySettings = JqueryDaySettings
+    { jdsChangeMonth :: Bool
+    , jdsChangeYear :: Bool
+    , jdsYearRange :: String
+    , jdsNumberOfMonths :: Either Int (Int, Int)
+    }
+
+instance Default JqueryDaySettings where
+    def = JqueryDaySettings
+        { jdsChangeMonth = False
+        , jdsChangeYear = False
+        , jdsYearRange = "c-10:c+10"
+        , jdsNumberOfMonths = Left 1
+        }
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
--- a/Yesod/Form/Nic.hs
+++ b/Yesod/Form/Nic.hs
@@ -1,65 +1,61 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
--- | Provide the user with a rich text editor.
-module Yesod.Form.Nic
-    ( YesodNic (..)
-    , nicHtmlField
-    , maybeNicHtmlField
-    ) where
-
-import Yesod.Handler
-import Yesod.Form.Core
-import Yesod.Widget
-import Text.HTML.SanitizeXSS (sanitizeBalance)
-import Text.Hamlet (Html, hamlet)
-import Text.Julius (julius)
-import Text.Blaze.Renderer.String (renderHtml)
-import Text.Blaze (preEscapedString)
-import Control.Monad.Trans.Class (lift)
-import Data.Text (Text, pack, unpack)
-
-class YesodNic a where
-    -- | NIC Editor Javascript file.
-    urlNicEdit :: a -> Either (Route a) Text
-    urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
-
-nicHtmlField :: (IsForm f, FormType f ~ Html, YesodNic (FormMaster f))
-             => FormFieldSettings -> Maybe Html -> f
-nicHtmlField = requiredFieldHelper nicHtmlFieldProfile
-
-maybeNicHtmlField
-    :: (IsForm f, FormType f ~ Maybe Html, YesodNic (FormMaster f))
-    => FormFieldSettings -> Maybe (FormType f) -> f
-maybeNicHtmlField = optionalFieldHelper nicHtmlFieldProfile
-
-nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html
-nicHtmlFieldProfile = FieldProfile
-    { fpParse = Right . preEscapedString . sanitizeBalance . unpack -- FIXME
-    , fpRender = pack . renderHtml
-    , fpWidget = \theId name val _isReq -> do
-        addHtml
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-    <textarea id="#{theId}" name="#{name}" .html>#{val}
-|]
-        addScript' urlNicEdit
-        addJulius
-#if __GLASGOW_HASKELL__ >= 700
-                [julius|
-#else
-                [$julius|
-#endif
-bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")});
-|]
-    }
-
-addScript' :: (y -> Either (Route y) Text) -> GWidget sub y ()
-addScript' f = do
-    y <- lift getYesod
-    addScriptEither $ f y
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove
+-- | Provide the user with a rich text editor.
+module Yesod.Form.Nic
+    ( YesodNic (..)
+    , nicHtmlField
+    ) where
+
+import Yesod.Handler
+import Yesod.Form
+import Yesod.Widget
+import Text.HTML.SanitizeXSS (sanitizeBalance)
+import Text.Hamlet (Html, hamlet)
+import Text.Julius (julius)
+import Text.Blaze.Renderer.String (renderHtml)
+import Text.Blaze (preEscapedString)
+import Control.Monad.Trans.Class (lift)
+import Data.Text (Text, pack, unpack)
+
+class YesodNic a where
+    -- | NIC Editor Javascript file.
+    urlNicEdit :: a -> Either (Route a) Text
+    urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
+
+blank :: (Text -> Either msg a) -> Maybe Text -> Either msg (Maybe a)
+blank _ Nothing = Right Nothing
+blank _ (Just "") = Right Nothing
+blank f (Just t) = either Left (Right . Just) $ f t
+
+nicHtmlField :: YesodNic master => Field (GWidget sub master ()) msg Html
+nicHtmlField = Field
+    { fieldParse = blank $ Right . preEscapedString . sanitizeBalance . unpack -- FIXME
+    , fieldRender = pack . renderHtml
+    , fieldView = \theId name val _isReq -> do
+        addHtml
+#if __GLASGOW_HASKELL__ >= 700
+                [hamlet|
+#else
+                [$hamlet|
+#endif
+    <textarea id="#{theId}" name="#{name}" .html>#{val}
+|]
+        addScript' urlNicEdit
+        addJulius
+#if __GLASGOW_HASKELL__ >= 700
+                [julius|
+#else
+                [$julius|
+#endif
+bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")});
+|]
+    }
+
+addScript' :: (y -> Either (Route y) Text) -> GWidget sub y ()
+addScript' f = do
+    y <- lift getYesod
+    addScriptEither $ f y
diff --git a/Yesod/Form/Profiles.hs b/Yesod/Form/Profiles.hs
deleted file mode 100644
--- a/Yesod/Form/Profiles.hs
+++ /dev/null
@@ -1,251 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE CPP #-}
-module Yesod.Form.Profiles
-    ( stringFieldProfile
-    , passwordFieldProfile
-    , textareaFieldProfile
-    , hiddenFieldProfile
-    , intFieldProfile
-    , dayFieldProfile
-    , timeFieldProfile
-    , htmlFieldProfile
-    , emailFieldProfile
-    , searchFieldProfile
-    , AutoFocus
-    , urlFieldProfile
-    , doubleFieldProfile
-    , parseDate
-    , parseTime
-    , Textarea (..)
-    ) where
-
-import Yesod.Form.Core
-import Yesod.Widget
-import Text.Hamlet hiding (renderHtml)
-import Text.Blaze (ToHtml (..))
-import Text.Cassius
-import Data.Time (Day, TimeOfDay(..))
-import qualified Text.Email.Validate as Email
-import Network.URI (parseURI)
-import Database.Persist (PersistField)
-import Text.HTML.SanitizeXSS (sanitizeBalance)
-import Control.Monad (when)
-
-import qualified Blaze.ByteString.Builder.Html.Utf8 as B
-import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
-import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
-
-import Text.Blaze.Renderer.String (renderHtml)
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-import Data.Text (Text, unpack, pack)
-
-#if __GLASGOW_HASKELL__ >= 700
-#define HAMLET hamlet
-#define CASSIUS cassius
-#define JULIUS julius
-#else
-#define HAMLET $hamlet
-#define CASSIUS $cassius
-#define JULIUS $julius
-#endif
-
-intFieldProfile :: Integral i => FieldProfile sub y i
-intFieldProfile = FieldProfile
-    { fpParse = maybe (Left "Invalid integer") Right . readMayI . unpack -- FIXME Data.Text.Read
-    , fpRender = pack . showI
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="number" :isReq:required="" value="#{val}">
-|]
-    }
-  where
-    showI x = show (fromIntegral x :: Integer)
-    readMayI s = case reads s of
-                    (x, _):_ -> Just $ fromInteger x
-                    [] -> Nothing
-
-doubleFieldProfile :: FieldProfile sub y Double
-doubleFieldProfile = FieldProfile
-    { fpParse = maybe (Left "Invalid number") Right . readMay . unpack -- FIXME use Data.Text.Read
-    , fpRender = pack . show
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}">
-|]
-    }
-
-dayFieldProfile :: FieldProfile sub y Day
-dayFieldProfile = FieldProfile
-    { fpParse = parseDate . unpack
-    , fpRender = pack . show
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
-|]
-    }
-
-timeFieldProfile :: FieldProfile sub y TimeOfDay
-timeFieldProfile = FieldProfile
-    { fpParse = parseTime . unpack
-    , fpRender = pack . show . roundFullSeconds
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
-|]
-    }
-  where
-    roundFullSeconds tod =
-        TimeOfDay (todHour tod) (todMin tod) fullSec
-      where
-        fullSec = fromInteger $ floor $ todSec tod
-
-htmlFieldProfile :: FieldProfile sub y Html
-htmlFieldProfile = FieldProfile
-    { fpParse = Right . preEscapedString . sanitizeBalance . unpack -- FIXME make changes to xss-sanitize
-    , fpRender = pack . renderHtml
-    , fpWidget = \theId name val _isReq -> addHamlet
-        [HAMLET|\
-<textarea id="#{theId}" name="#{name}" .html>#{val}
-|]
-    }
-
--- | A newtype wrapper around a 'String' that converts newlines to HTML
--- br-tags.
-newtype Textarea = Textarea { unTextarea :: Text }
-    deriving (Show, Read, Eq, PersistField)
-instance ToHtml Textarea where
-    toHtml =
-        unsafeByteString
-        . S.concat
-        . L.toChunks
-        . toLazyByteString
-        . fromWriteList writeHtmlEscapedChar
-        . unpack
-        . unTextarea
-      where
-        -- Taken from blaze-builder and modified with newline handling.
-        writeHtmlEscapedChar '\n' = writeByteString "<br>"
-        writeHtmlEscapedChar c    = B.writeHtmlEscapedChar c
-
-textareaFieldProfile :: FieldProfile sub y Textarea
-textareaFieldProfile = FieldProfile
-    { fpParse = Right . Textarea
-    , fpRender = unTextarea
-    , fpWidget = \theId name val _isReq -> addHamlet
-        [HAMLET|\
-<textarea id="#{theId}" name="#{name}">#{val}
-|]
-    }
-
-hiddenFieldProfile :: FieldProfile sub y Text
-hiddenFieldProfile = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val _isReq -> addHamlet
-        [HAMLET|\
-<input type="hidden" id="#{theId}" name="#{name}" value="#{val}">
-|]
-    }
-
-stringFieldProfile :: FieldProfile sub y Text
-stringFieldProfile = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}">
-|]
-    }
-
-passwordFieldProfile :: FieldProfile s m Text
-passwordFieldProfile = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="password" :isReq:required="" value="#{val}">
-|]
-    }
-
-readMay :: Read a => String -> Maybe a
-readMay s = case reads s of
-                (x, _):_ -> Just x
-                [] -> Nothing
-
-parseDate :: String -> Either Text Day
-parseDate = maybe (Left "Invalid day, must be in YYYY-MM-DD format") Right
-              . readMay . replace '/' '-'
-
--- | Replaces all instances of a value in a list by another value.
--- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
-replace :: Eq a => a -> a -> [a] -> [a]
-replace x y = map (\z -> if z == x then y else z)
-
-parseTime :: String -> Either Text TimeOfDay
-parseTime (h2:':':m1:m2:[]) = parseTimeHelper ('0', h2, m1, m2, '0', '0')
-parseTime (h1:h2:':':m1:m2:[]) = parseTimeHelper (h1, h2, m1, m2, '0', '0')
-parseTime (h1:h2:':':m1:m2:' ':'A':'M':[]) =
-    parseTimeHelper (h1, h2, m1, m2, '0', '0')
-parseTime (h1:h2:':':m1:m2:' ':'P':'M':[]) =
-    let [h1', h2'] = show $ (read [h1, h2] :: Int) + 12
-    in parseTimeHelper (h1', h2', m1, m2, '0', '0')
-parseTime (h1:h2:':':m1:m2:':':s1:s2:[]) =
-    parseTimeHelper (h1, h2, m1, m2, s1, s2)
-parseTime _ = Left "Invalid time, must be in HH:MM[:SS] format"
-
-parseTimeHelper :: (Char, Char, Char, Char, Char, Char)
-                -> Either Text TimeOfDay
-parseTimeHelper (h1, h2, m1, m2, s1, s2)
-    | h < 0 || h > 23 = Left $ pack $ "Invalid hour: " ++ show h
-    | m < 0 || m > 59 = Left $ pack $ "Invalid minute: " ++ show m
-    | s < 0 || s > 59 = Left $ pack $ "Invalid second: " ++ show s
-    | otherwise = Right $ TimeOfDay h m s
-  where
-    h = read [h1, h2]
-    m = read [m1, m2]
-    s = fromInteger $ read [s1, s2]
-
-emailFieldProfile :: FieldProfile s y Text
-emailFieldProfile = FieldProfile
-    { fpParse = \s -> if Email.isValid (unpack s)
-                        then Right s
-                        else Left "Invalid e-mail address"
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="email" :isReq:required="" value="#{val}">
-|]
-    }
-
-type AutoFocus = Bool
-searchFieldProfile :: AutoFocus -> FieldProfile s y Text
-searchFieldProfile autoFocus = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> do
-        addHtml [HAMLET|\
-<input id="#{theId}" name="#{name}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{val}">
-|]
-        when autoFocus $ do
-          addHtml $ [HAMLET|\<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}</script> 
-|]
-          addCassius [CASSIUS|
-            #{theId}
-              -webkit-appearance: textfield
-            |]
-    }
-
-urlFieldProfile :: FieldProfile s y Text
-urlFieldProfile = FieldProfile
-    { fpParse = \s -> case parseURI $ unpack s of
-                        Nothing -> Left "Invalid URL"
-                        Just _ -> Right s
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> addHamlet
-        [HAMLET|\
-<input id="#{theId}" name="#{name}" type="url" :isReq:required="" value="#{val}">
-|]
-    }
diff --git a/Yesod/Form/Types.hs b/Yesod/Form/Types.hs
new file mode 100644
--- /dev/null
+++ b/Yesod/Form/Types.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+module Yesod.Form.Types
+    ( -- * Helpers
+      Enctype (..)
+    , FormResult (..)
+    , Env
+    , FileEnv
+    , Ints (..)
+      -- * Form
+    , Form
+    , AForm (..)
+      -- * Build forms
+    , Field (..)
+    , FieldSettings (..)
+    , FieldView (..)
+    ) where
+
+import Control.Monad.Trans.RWS (RWST)
+import Yesod.Request (FileInfo)
+import Data.Text (Text)
+import Data.Monoid (Monoid (..))
+import Text.Blaze (Html, ToHtml (toHtml))
+import Control.Applicative ((<$>), Applicative (..))
+import Control.Monad (liftM)
+import Data.String (IsString (..))
+import Control.Monad.Trans.Class (MonadTrans (..))
+
+-- | 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 [Text]
+                  | FormSuccess a
+    deriving Show
+instance Functor FormResult where
+    fmap _ FormMissing = FormMissing
+    fmap _ (FormFailure errs) = FormFailure errs
+    fmap f (FormSuccess a) = FormSuccess $ f a
+instance Applicative FormResult where
+    pure = FormSuccess
+    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
+    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
+    (FormFailure x) <*> _ = FormFailure x
+    _ <*> (FormFailure y) = FormFailure y
+    _ <*> _ = FormMissing
+instance Monoid m => Monoid (FormResult m) where
+    mempty = pure mempty
+    mappend x y = mappend <$> x <*> y
+
+-- | The encoding type required by a form. The 'ToHtml' instance produces values
+-- that can be inserted directly into HTML.
+data Enctype = UrlEncoded | Multipart
+    deriving (Eq, Enum, Bounded)
+instance ToHtml Enctype where
+    toHtml UrlEncoded = "application/x-www-form-urlencoded"
+    toHtml Multipart = "multipart/form-data"
+instance Monoid Enctype where
+    mempty = UrlEncoded
+    mappend UrlEncoded UrlEncoded = UrlEncoded
+    mappend _ _ = Multipart
+
+data Ints = IntCons Int Ints | IntSingle Int
+instance Show Ints where
+    show (IntSingle i) = show i
+    show (IntCons i is) = show i ++ ('-' : show is)
+
+type Env = [(Text, Text)] -- FIXME use a Map
+type FileEnv = [(Text, FileInfo)]
+
+type Form master m a = RWST (Maybe (Env, FileEnv), master, [Text]) Enctype Ints m a
+
+newtype AForm xml master m a = AForm
+    { unAForm :: (master, [Text]) -> Maybe (Env, FileEnv) -> Ints -> m (FormResult a, xml, Ints, Enctype)
+    }
+instance Monad m => Functor (AForm xml msg m) where
+    fmap f (AForm a) =
+        AForm $ \x y z -> liftM go $ a x y z
+      where
+        go (w, x, y, z) = (fmap f w, x, y, z)
+instance (Monad m, Monoid xml) => Applicative (AForm xml msg m) where
+    pure x = AForm $ const $ const $ \ints -> return (FormSuccess x, mempty, ints, mempty)
+    (AForm f) <*> (AForm g) = AForm $ \mr env ints -> do
+        (a, b, ints', c) <- f mr env ints
+        (x, y, ints'', z) <- g mr env ints'
+        return (a <*> x, b `mappend` y, ints'', c `mappend` z)
+instance (Monad m, Monoid xml, Monoid a) => Monoid (AForm xml msg m a) where
+    mempty = pure mempty
+    mappend a b = mappend <$> a <*> b
+instance Monoid xml => MonadTrans (AForm xml msg) where
+    lift mx = AForm $ const $ const $ \ints -> do
+        x <- mx
+        return (pure x, mempty, ints, mempty)
+
+data FieldSettings msg = FieldSettings
+    { fsLabel :: msg
+    , fsTooltip :: Maybe msg
+    , fsId :: Maybe Text
+    , fsName :: Maybe Text
+    }
+
+instance (a ~ Text) => IsString (FieldSettings a) where
+    fromString s = FieldSettings (fromString s) Nothing Nothing Nothing
+
+data FieldView xml = FieldView
+    { fvLabel :: Html
+    , fvTooltip :: Maybe Html
+    , fvId :: Text
+    , fvInput :: xml
+    , fvErrors :: Maybe Html
+    , fvRequired :: Bool
+    }
+
+data Field xml msg a = Field
+    { fieldParse :: Maybe Text -> Either msg (Maybe a)
+    , fieldRender :: a -> Text
+    , fieldView :: Text -- ^ ID
+                -> Text -- ^ name
+                -> Text -- ^ value
+                -> Bool -- ^ required?
+                -> xml
+    }
diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs
deleted file mode 100644
--- a/Yesod/Helpers/Crud.hs
+++ /dev/null
@@ -1,203 +0,0 @@
-{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-module Yesod.Helpers.Crud
-    ( Item (..)
-    , Crud (..)
-    , CrudRoute (..)
-    , defaultCrud
-    ) where
-
-import Yesod.Core
-import Text.Hamlet
-import Yesod.Form
-import Language.Haskell.TH.Syntax
-import Yesod.Persist
-import Data.Text (Text)
-import Web.Routes.Quasi (toSinglePiece, fromSinglePiece)
-
--- | An entity which can be displayed by the Crud subsite.
-class Item a where
-    -- | The title of an entity, to be displayed in the list of all entities.
-    itemTitle :: a -> Text
-
--- | 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 ()
-    , crudInsert :: item -> GHandler (Crud master item) master (Key item)
-    , crudGet :: Key item -> GHandler (Crud master item) master (Maybe item)
-    , crudDelete :: Key item -> GHandler (Crud master item) master ()
-    }
-
-mkYesodSub "Crud master item"
-    [ ClassP ''Item [VarT $ mkName "item"]
-    , ClassP ''SinglePiece [ConT ''Key `AppT` VarT (mkName "item")]
-    , ClassP ''ToForm [VarT $ mkName "item", VarT $ mkName "master"]
-    ]
-#if __GLASGOW_HASKELL__ >= 700
-                [parseRoutes|
-#else
-                [$parseRoutes|
-#endif
-/               CrudListR        GET
-/add            CrudAddR         GET POST
-/edit/#Text     CrudEditR        GET POST
-/delete/#Text   CrudDeleteR      GET POST
-|]
-
-getCrudListR :: (Yesod master, Item item, SinglePiece (Key item))
-             => GHandler (Crud master item) master RepHtml
-getCrudListR = do
-    items <- getYesodSub >>= crudSelect
-    toMaster <- getRouteToMaster
-    defaultLayout $ do
-        setTitle "Items"
-        addWidget
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-<h1>Items
-<ul>
-    $forall item <- items
-        <li>
-            <a href="@{toMaster (CrudEditR (toSinglePiece (fst item)))}">
-                \#{itemTitle (snd item)}
-<p>
-    <a href="@{toMaster CrudAddR}">Add new item
-|]
-
-getCrudAddR :: (Yesod master, Item item, SinglePiece (Key item),
-                ToForm item master)
-            => GHandler (Crud master item) master RepHtml
-getCrudAddR = crudHelper
-                "Add new"
-                (Nothing :: Maybe (Key item, item))
-                False
-
-postCrudAddR :: (Yesod master, Item item, SinglePiece (Key item),
-                 ToForm item master)
-             => GHandler (Crud master item) master RepHtml
-postCrudAddR = crudHelper
-                "Add new"
-                (Nothing :: Maybe (Key item, item))
-                True
-
-getCrudEditR :: (Yesod master, Item item, SinglePiece (Key item),
-                 ToForm item master)
-             => Text -> GHandler (Crud master item) master RepHtml
-getCrudEditR s = do
-    itemId <- maybe notFound return $ fromSinglePiece s
-    crud <- getYesodSub
-    item <- crudGet crud itemId >>= maybe notFound return
-    crudHelper
-        "Edit item"
-        (Just (itemId, item))
-        False
-
-postCrudEditR :: (Yesod master, Item item, SinglePiece (Key item),
-                  ToForm item master)
-              => Text -> GHandler (Crud master item) master RepHtml
-postCrudEditR s = do
-    itemId <- maybe notFound return $ fromSinglePiece s
-    crud <- getYesodSub
-    item <- crudGet crud itemId >>= maybe notFound return
-    crudHelper
-        "Edit item"
-        (Just (itemId, item))
-        True
-
-getCrudDeleteR :: (Yesod master, Item item, SinglePiece (Key item))
-               => Text -> GHandler (Crud master item) master RepHtml
-getCrudDeleteR s = do
-    itemId <- maybe notFound return $ fromSinglePiece s
-    crud <- getYesodSub
-    item <- crudGet crud itemId >>= maybe notFound return -- Just ensure it exists
-    toMaster <- getRouteToMaster
-    defaultLayout $ do
-        setTitle "Confirm delete"
-        addWidget
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-<form method="post" action="@{toMaster (CrudDeleteR s)}">
-    <h1>Really delete?
-    <p>Do you really want to delete #{itemTitle item}?
-    <p>
-        <input type="submit" value="Yes">
-        \
-        <a href="@{toMaster CrudListR}">No
-|]
-
-postCrudDeleteR :: (Yesod master, Item item, SinglePiece (Key item))
-                => Text -> GHandler (Crud master item) master RepHtml
-postCrudDeleteR s = do
-    itemId <- maybe notFound return $ fromSinglePiece s
-    crud <- getYesodSub
-    toMaster <- getRouteToMaster
-    crudDelete crud itemId
-    redirect RedirectTemporary $ toMaster CrudListR
-
-crudHelper
-    :: (Item a, Yesod master, SinglePiece (Key a), ToForm a master)
-    => Text -> Maybe (Key a, a) -> Bool
-    -> GHandler (Crud master a) master RepHtml
-crudHelper title me isPost = do
-    crud <- getYesodSub
-    (errs, form, enctype, hidden) <- runFormPost $ toForm $ fmap snd me
-    toMaster <- getRouteToMaster
-    case (isPost, errs) of
-        (True, FormSuccess a) -> do
-            eid <- case me of
-                    Just (eid, _) -> do
-                        crudReplace crud eid a
-                        return eid
-                    Nothing -> crudInsert crud a
-            redirect RedirectTemporary $ toMaster $ CrudEditR
-                                       $ toSinglePiece eid
-        _ -> return ()
-    defaultLayout $ do
-        setTitle $ toHtml title
-        addWidget
-#if __GLASGOW_HASKELL__ >= 700
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-<p>
-    <a href="@{toMaster CrudListR}">Return to list
-<h1>#{title}
-<form method="post" enctype="#{enctype}">
-    <table>
-        \^{form}
-        <tr>
-            <td colspan="2">
-                \#{hidden}
-                <input type="submit">
-                $maybe e <- me
-                    \
-                    <a href="@{toMaster (CrudDeleteR (toSinglePiece (fst e)))}">Delete
-|]
-
--- | A default 'Crud' value which relies about persistent and "Yesod.Form".
-defaultCrud
-    :: (PersistEntity i, PersistBackend (YesodDB a (GGHandler (Crud a i) a IO)),
-        YesodPersist a)
-    => a -> Crud a i
-defaultCrud = const Crud
-    { crudSelect = runDB $ selectList [] [] 0 0
-    , crudReplace = \a -> runDB . replace a
-    , crudInsert = runDB . insert
-    , crudGet = runDB . get
-    , crudDelete = runDB . delete
-    }
diff --git a/yesod-form.cabal b/yesod-form.cabal
--- a/yesod-form.cabal
+++ b/yesod-form.cabal
@@ -1,44 +1,46 @@
-name:            yesod-form
-version:         0.1.0.1
-license:         BSD3
-license-file:    LICENSE
-author:          Michael Snoyman <michael@snoyman.com>
-maintainer:      Michael Snoyman <michael@snoyman.com>
-synopsis:        Form handling support for Yesod Web Framework
-category:        Web, Yesod
-stability:       Stable
-cabal-version:   >= 1.6
-build-type:      Simple
-homepage:        http://www.yesodweb.com/
-
-library
-    build-depends:   base                      >= 4        && < 5
-                   , yesod-core                >= 0.8      && < 0.9
-                   , time                      >= 1.1.4    && < 1.3
-                   , hamlet                    >= 0.8      && < 0.9
-                   , persistent                >= 0.5      && < 0.6
-                   , yesod-persistent          >= 0.1      && < 0.2
-                   , template-haskell
-                   , transformers              >= 0.2.2    && < 0.3
-                   , data-default              >= 0.2      && < 0.3
-                   , xss-sanitize              >= 0.2.4    && < 0.3
-                   , blaze-builder             >= 0.2.1    && < 0.4
-                   , network                   >= 2.2      && < 2.4
-                   , email-validate            >= 0.2.6    && < 0.3
-                   , blaze-html                >= 0.4      && < 0.5
-                   , bytestring                >= 0.9      && < 0.10
-                   , text                      >= 0.7      && < 1.0
-                   , web-routes-quasi          >= 0.7      && < 0.8
-    exposed-modules: Yesod.Form
-                     Yesod.Form.Class
-                     Yesod.Form.Core
-                     Yesod.Form.Fields
-                     Yesod.Form.Jquery
-                     Yesod.Form.Nic
-                     Yesod.Form.Profiles
-                     Yesod.Helpers.Crud
-    ghc-options:     -Wall
-
-source-repository head
-  type:     git
-  location: git://github.com/snoyberg/yesod-form.git
+name:            yesod-form
+version:         0.2.0
+license:         BSD3
+license-file:    LICENSE
+author:          Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+synopsis:        Form handling support for Yesod Web Framework
+category:        Web, Yesod
+stability:       Stable
+cabal-version:   >= 1.6
+build-type:      Simple
+homepage:        http://www.yesodweb.com/
+
+library
+    build-depends:   base                      >= 4        && < 5
+                   , yesod-core                >= 0.8.2    && < 0.9
+                   , time                      >= 1.1.4    && < 1.3
+                   , hamlet                    >= 0.8.1    && < 0.9
+                   , persistent                >= 0.5      && < 0.6
+                   , yesod-persistent          >= 0.1      && < 0.2
+                   , template-haskell
+                   , transformers              >= 0.2.2    && < 0.3
+                   , data-default              >= 0.2      && < 0.3
+                   , xss-sanitize              >= 0.2.4    && < 0.3
+                   , blaze-builder             >= 0.2.1    && < 0.4
+                   , network                   >= 2.2      && < 2.4
+                   , email-validate            >= 0.2.6    && < 0.3
+                   , blaze-html                >= 0.4      && < 0.5
+                   , bytestring                >= 0.9      && < 0.10
+                   , text                      >= 0.7      && < 1.0
+                   , web-routes-quasi          >= 0.7      && < 0.8
+                   , wai                       >= 0.4      && < 0.5
+    exposed-modules: Yesod.Form
+                     Yesod.Form.Class
+                     Yesod.Form.Types
+                     Yesod.Form.Functions
+                     Yesod.Form.Input
+                     Yesod.Form.Fields
+                     Yesod.Form.Jquery
+                     Yesod.Form.Nic
+                     -- FIXME Yesod.Helpers.Crud
+    ghc-options:     -Wall
+
+source-repository head
+  type:     git
+  location: git://github.com/snoyberg/yesod-form.git