diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
index 98291d47..fc945240 100644
--- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs
@@ -1,444 +1,251 @@
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
 module Yesod.Form.Fields
-    ( -- * Fields
-      -- ** Required
-      stringField
+    ( textField
     , passwordField
     , textareaField
     , hiddenField
     , intField
-    , doubleField
     , dayField
     , timeField
     , htmlField
-    , selectField
-    , radioField
-    , boolField
     , emailField
     , searchField
+    , AutoFocus
     , urlField
-    , fileField
-      -- ** Optional
-    , maybeStringField
-    , maybePasswordField
-    , maybeTextareaField
-    , maybeHiddenField
-    , maybeIntField
-    , maybeDoubleField
-    , maybeDayField
-    , maybeTimeField
-    , maybeHtmlField
-    , maybeSelectField
-    , maybeRadioField
-    , maybeEmailField
-    , maybeSearchField
-    , maybeUrlField
-    , maybeFileField
-    {- FIXME
-      -- * Inputs
-      -- ** Required
-    , stringInput
-    , intInput
-    , boolInput
-    , dayInput
-    , emailInput
-    , urlInput
-      -- ** Optional
-    , maybeStringInput
-    , maybeDayInput
-    , maybeIntInput
-    -}
+    , doubleField
+    , parseDate
+    , parseTime
+    , Textarea (..)
     ) 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
+import Yesod.Form.Types
+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
 
-stringField = requiredFieldHelper stringFieldProfile
-
-maybeStringField = optionalFieldHelper stringFieldProfile
-
-passwordField = requiredFieldHelper passwordFieldProfile
-
-maybePasswordField = optionalFieldHelper passwordFieldProfile
-
-{- FIXME
-intInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper intFieldProfile (nameSettings n) Nothing
-
-maybeIntInput n =
-    mapFormXml fieldsToInput $
-    optionalFieldHelper intFieldProfile (nameSettings n) Nothing
--}
-
-intField = requiredFieldHelper intFieldProfile
-
-maybeIntField = optionalFieldHelper intFieldProfile
-
-doubleField = requiredFieldHelper doubleFieldProfile
-
-maybeDoubleField = optionalFieldHelper doubleFieldProfile
-
-dayField = requiredFieldHelper dayFieldProfile
-
-maybeDayField = optionalFieldHelper dayFieldProfile
-
-timeField = requiredFieldHelper timeFieldProfile
-
-maybeTimeField = optionalFieldHelper timeFieldProfile
-
-boolField ffs orig = 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="">
+intField :: (Monad monad, Integral i) => Field (GGWidget master monad ()) i
+intField = Field
+    { fieldParse = maybe (Left "Invalid integer") Right . readMayI . unpack -- FIXME Data.Text.Read
+    , fieldRender = pack . showI
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="number" :isReq:required="" value="#{val}">
 |]
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ toHtml x
-                            _ -> Nothing
-            , fiRequired = True
-            }
-    return (res, fi, UrlEncoded)
+    }
+  where
+    showI x = show (fromIntegral x :: Integer)
+    readMayI s = case reads s of
+                    (x, _):_ -> Just $ fromInteger x
+                    [] -> Nothing
 
-htmlField = requiredFieldHelper htmlFieldProfile
-
-maybeHtmlField = optionalFieldHelper htmlFieldProfile
-
-selectField pairs ffs initial = 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)}
+doubleField :: Monad monad => Field (GGWidget master monad ()) Double
+doubleField = Field
+    { fieldParse = maybe (Left "Invalid number") Right . readMay . unpack -- FIXME use Data.Text.Read
+    , fieldRender = pack . show
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}">
 |]
-    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 pairs ffs initial' = 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)}
+dayField :: Monad monad => Field (GGWidget master monad ()) Day
+dayField = Field
+    { fieldParse = parseDate . unpack
+    , fieldRender = pack . show
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
 |]
-    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)
+    }
 
-{- FIXME
-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}">
+timeField :: Monad monad => Field (GGWidget master monad ()) TimeOfDay
+timeField = Field
+    { fieldParse = parseTime . unpack
+    , fieldRender = pack . show . roundFullSeconds
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
 |]
-    return (res, [xml], UrlEncoded)
+    }
+  where
+    roundFullSeconds tod =
+        TimeOfDay (todHour tod) (todMin tod) fullSec
+      where
+        fullSec = fromInteger $ floor $ todSec tod
 
-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 = requiredFieldHelper urlFieldProfile
-
-maybeUrlField = optionalFieldHelper urlFieldProfile
-
-{- FIXME
-urlInput :: Text -> FormInput sub master Text
-urlInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper urlFieldProfile (nameSettings n) Nothing
--}
-
-emailField = requiredFieldHelper emailFieldProfile
-
-maybeEmailField = optionalFieldHelper emailFieldProfile
-
-{- FIXME
-emailInput :: Text -> FormInput sub master Text
-emailInput n =
-    mapFormXml fieldsToInput $
-    requiredFieldHelper emailFieldProfile (nameSettings n) Nothing
--}
-
-searchField = requiredFieldHelper . searchFieldProfile
-
-maybeSearchField = optionalFieldHelper . searchFieldProfile
-
-textareaField = requiredFieldHelper textareaFieldProfile
-
-maybeTextareaField = optionalFieldHelper textareaFieldProfile
-
-hiddenField = requiredFieldHelper hiddenFieldProfile
-
-maybeHiddenField = optionalFieldHelper hiddenFieldProfile
-
-fileField ffs = 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 ffs = 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="">
+htmlField :: Monad monad => Field (GGWidget master monad ()) Html
+htmlField = Field
+    { fieldParse = 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}
 |]
+    }
 
-radioField pairs ffs initial = 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)
+-- | 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
 
-maybeRadioField pairs ffs initial' = 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)}
+textareaField :: Monad monad => Field (GGWidget master monad ()) Textarea
+textareaField = Field
+    { fieldParse = Right . Textarea
+    , fieldRender = unTextarea
+    , fieldView = \theId name val _isReq -> addHamlet
+        [HAMLET|\
+<textarea id="#{theId}" name="#{name}">#{val}
 |]
-    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)
+    }
+
+hiddenField :: Monad monad => Field (GGWidget master monad ()) Text
+hiddenField = Field
+    { fieldParse = 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 ()) Text
+textField = Field
+    { fieldParse = Right
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> addHamlet
+        [HAMLET|\
+<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}">
+|]
+    }
+
+passwordField :: Monad monad => Field (GGWidget master monad ()) Text
+passwordField = Field
+    { fieldParse = 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 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]
+
+emailField :: Monad monad => Field (GGWidget master monad ()) Text
+emailField = Field
+    { fieldParse = \s -> if Email.isValid (unpack s)
+                        then Right s
+                        else Left "Invalid e-mail address"
+    , 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 ()) Text
+searchField autoFocus = Field
+    { fieldParse = 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 ()) Text
+urlField = Field
+    { fieldParse = \s -> case parseURI $ unpack s of
+                        Nothing -> Left "Invalid URL"
+                        Just _ -> Right s
+    , fieldRender = id
+    , fieldView = \theId name val isReq -> addHtml
+        [HAMLET|
+<input ##{theId} name=#{name} type=url :isReq:required value=#{val}>
+|]
+    }
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
new file mode 100644
index 00000000..ded97a85
--- /dev/null
+++ b/Yesod/Form/Functions.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+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 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)
+import Text.Blaze (Html)
+import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody)
+import Yesod.Widget (GGWidget, whamlet)
+import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams)
+import Network.Wai (requestMethod)
+import Text.Hamlet.NonPoly (html)
+import Data.Monoid (mempty)
+
+#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 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 m (FormResult a, xml) -> AForm ([xml] -> [xml]) m a
+formToAForm form = AForm $ \env ints -> do
+    ((a, xml), ints', enc) <- runRWST form env ints
+    return (a, (:) xml, ints', enc)
+
+aFormToForm :: Monad m => AForm xml m a -> Form m (FormResult a, xml)
+aFormToForm (AForm aform) = do
+    ints <- get
+    env <- ask
+    (a, xml, ints', enc) <- lift $ aform env ints
+    put ints'
+    tell enc
+    return (a, xml)
+
+askParams :: Monad m => Form m (Maybe Env)
+askParams = liftM (liftM fst) ask
+
+askFiles :: Monad m => Form m (Maybe FileEnv)
+askFiles = liftM (liftM snd) ask
+
+mreq :: Monad m => Field xml a -> Maybe a -> Form m (FormResult a, xml)
+mreq = undefined
+
+mopt :: Monad m => Field xml a -> Maybe (Maybe a) -> Form m (FormResult (Maybe a), xml)
+mopt = undefined
+
+areq :: Monad m => Field xml a -> Maybe a -> AForm ([xml] -> [xml]) m a
+areq a b = formToAForm $ mreq a b
+
+aopt :: Monad m => Field xml a -> Maybe (Maybe a) -> AForm ([xml] -> [xml]) m (Maybe a)
+aopt a b = formToAForm $ mopt a b
+
+runFormGeneric :: Monad m => Form m a -> Maybe (Env, FileEnv) -> m (a, Enctype)
+runFormGeneric form env = evalRWST form env (IntSingle 1)
+
+runFormPost :: (Html -> Form (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
+    ((res, xml), enctype) <- runFormGeneric (form nonce) env
+    let res' =
+            case (res, env) of
+                (FormSuccess{}, Just (params, _))
+                    | lookup nonceKey params /= reqNonce req ->
+                        FormFailure [csrfWarning]
+                _ -> res
+    return ((res', xml), enctype)
+
+csrfWarning :: Text
+csrfWarning = "As a protection against cross-site request forgery attacks, please confirm your form submission." -- TRANS
+
+runFormPostNoNonce :: (Html -> Form (GHandler sub master) a) -> GHandler sub master (a, Enctype)
+runFormPostNoNonce form = do
+    req <- getRequest
+    env <- if requestMethod (reqWaiRequest req) == "GET"
+                then return Nothing
+                else fmap Just runRequestBody
+    runFormGeneric (form mempty) env
+
+runFormGet :: Monad m => (Html -> Form (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, [])
+    runFormGeneric (form fragment) env
+
+type FormRender master m a =
+       AForm ([FieldView (GGWidget master m ())] -> [FieldView (GGWidget master m ())]) m a
+    -> Html
+    -> Form m (FormResult a, GGWidget master m ())
+
+renderTable, renderDivs :: Monad m => FormRender master 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/Profiles.hs b/Yesod/Form/Profiles.hs
deleted file mode 100644
index 12c1ff3b..00000000
--- 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 :: (Monad monad, Integral i) => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) Textarea
-textareaFieldProfile = FieldProfile
-    { fpParse = Right . Textarea
-    , fpRender = unTextarea
-    , fpWidget = \theId name val _isReq -> addHamlet
-        [HAMLET|\
-<textarea id="#{theId}" name="#{name}">#{val}
-|]
-    }
-
-hiddenFieldProfile :: Monad monad => FieldProfile (GGWidget master monad ()) Text
-hiddenFieldProfile = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val _isReq -> addHamlet
-        [HAMLET|\
-<input type="hidden" id="#{theId}" name="#{name}" value="#{val}">
-|]
-    }
-
-stringFieldProfile :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) 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 :: Monad monad => AutoFocus -> FieldProfile (GGWidget master monad ()) 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 :: Monad monad => FieldProfile (GGWidget master monad ()) Text
-urlFieldProfile = FieldProfile
-    { fpParse = \s -> case parseURI $ unpack s of
-                        Nothing -> Left "Invalid URL"
-                        Just _ -> Right s
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> addHtml
-        [HAMLET|
-<input ##{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
index 00000000..2d80fe43
--- /dev/null
+++ b/Yesod/Form/Types.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE OverloadedStrings #-}
+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)]
+type FileEnv = [(Text, FileInfo)]
+
+type Form m a = RWST (Maybe (Env, FileEnv)) Enctype Ints m a
+
+newtype AForm xml m a = AForm
+    { unAForm :: Maybe (Env, FileEnv) -> Ints -> m (FormResult a, xml, Ints, Enctype)
+    }
+instance Monad m => Functor (AForm xml m) where
+    fmap f (AForm a) =
+        AForm $ \x y -> liftM go $ a x y
+      where
+        go (w, x, y, z) = (fmap f w, x, y, z)
+instance (Monad m, Monoid xml) => Applicative (AForm xml m) where
+    pure x = AForm $ const $ \ints -> return (FormSuccess x, mempty, ints, mempty)
+    (AForm f) <*> (AForm g) = AForm $ \env ints -> do
+        (a, b, ints', c) <- f env ints
+        (x, y, ints'', z) <- g env ints'
+        return (a <*> x, b `mappend` y, ints'', c `mappend` z)
+instance (Monad m, Monoid xml, Monoid a) => Monoid (AForm xml m a) where
+    mempty = pure mempty
+    mappend a b = mappend <$> a <*> b
+instance Monoid xml => MonadTrans (AForm xml) where
+    lift mx = AForm $ const $ \ints -> do
+        x <- mx
+        return (pure x, mempty, ints, mempty)
+
+data FieldSettings = FieldSettings
+    { fsLabel :: Html -- FIXME do we need Text?
+    , fsTooltip :: Maybe Html
+    , fsId :: Maybe Text
+    , fsName :: Maybe Text
+    }
+
+instance IsString FieldSettings 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 a = Field
+    { fieldParse :: Text -> Either Text a -- FIXME probably want to make this more sophisticated, handle no form, no field
+    , fieldRender :: a -> Text
+    , fieldView :: Text -- ^ ID
+                -> Text -- ^ name
+                -> Text -- ^ value
+                -> Bool -- ^ required?
+                -> xml
+    }