From 122f7f85a63c47d7a74c9f13ae4244d362f99ca8 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 9 May 2011 18:59:36 +0300
Subject: [PATCH] Clean build

---
 Yesod/Form.hs        | 318 +------------------------------------------
 Yesod/Form/Core.hs   | 298 ----------------------------------------
 Yesod/Form/Jquery.hs |  47 +++----
 Yesod/Form/Nic.hs    |  17 +--
 yesod-form.cabal     |   7 +-
 5 files changed, 33 insertions(+), 654 deletions(-)
 delete mode 100644 Yesod/Form/Core.hs

diff --git a/Yesod/Form.hs b/Yesod/Form.hs
index e3afde84..0eab5bcb 100644
--- a/Yesod/Form.hs
+++ b/Yesod/Form.hs
@@ -7,319 +7,13 @@
 {-# 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.Types
+    , module Yesod.Form.Functions
     , module Yesod.Form.Fields
+    -- FIXME , module Yesod.Form.Class
     ) where
 
-import Yesod.Form.Core
+import Yesod.Form.Types
+import Yesod.Form.Functions
 import Yesod.Form.Fields
-import Yesod.Form.Class
-import Yesod.Form.Profiles (Textarea (..))
-import Yesod.Widget (GWidget, GGWidget)
-
-import Text.Hamlet
-import Yesod.Request
-import Yesod.Handler
-import Control.Applicative hiding (optional)
-import Data.Maybe (fromMaybe, mapMaybe)
-import Control.Monad ((<=<), liftM)
-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)
-import Control.Monad.Trans.RWS (runRWST)
-
-#if __GLASGOW_HASKELL__ >= 700
-#define HAMLET hamlet
-#else
-#define HAMLET $hamlet
-#endif
--- | Display only the actual input widget code, without any decoration.
-fieldsToPlain :: (Monad mo, Monad mo') => GForm [FieldInfo (GGWidget master mo' ())] mo a -> GForm (GGWidget master mo' ()) mo a
-fieldsToPlain = mapFormXml $ mapM_ fiInput
-
--- | Display the label, tooltip, input code and errors in a single row of a
--- table.
-fieldsToTable :: (Monad mo, Monad mo') => GForm [FieldInfo (GGWidget master mo' ())] mo a -> GForm (GGWidget master mo' ()) mo 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 :: (Monad mo, Monad mo') => GForm [FieldInfo (GGWidget master mo' ())] mo a -> GForm (GGWidget master mo' ()) mo 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 xml (GHandler s m) a -> GHandler s m (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 xml (GHandler s m) (FormResult a) -> GHandler s m (FormResult a, xml, Enctype, Html)
-runFormPost f = do
-    (pp, files) <- runRequestBody
-    nonce <- liftM 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."] -- TRANS
-                _ -> res
-    return (res', xml, enctype, maybe mempty hidden nonce)
-  where
-    hidden nonce = [HAMLET|
-    <input type="hidden" name="#{nonceName}" value="#{nonce}">
-|]
-
-nonceName :: Text
-nonceName = "_nonce"
-
-{- FIXME
--- | 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
--}
-
-{- FIXME
--- | 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}">
-|])
--}
-
-{- FIXME
--- | 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}">
-|])
--}
-
-{- FIXME
--- | Run a form against GET parameters, disregarding the resulting HTML and
--- returning an error response on invalid input.
-runFormGet' :: GForm xml mo 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 :: Monad mo => GForm xml (GGHandler s m mo) a -> GGHandler s m mo (xml, Enctype, Html)
-generateForm f = do
-    (_, b, c) <- runFormGeneric [] [] f
-    nonce <- liftM reqNonce getRequest
-    return (b, c, [HAMLET|\
-$maybe n <- nonce
-    <input type="hidden" name="#{nonceName}" value="#{n}">
-|])
-
--- | Run a form against GET parameters.
-runFormGet :: Monad mo => GForm xml (GGHandler s m mo) a -> GGHandler s m mo (a, xml, Enctype)
-runFormGet f = do
-    gs <- reqGetParams `liftM` getRequest
-    runFormGeneric gs [] f
-
-runFormGeneric :: Monad mo => Env -> FileEnv -> GForm xml mo a -> mo (a, xml, Enctype)
-runFormGeneric e fe f = do
-    (a, _s, (enc, xml)) <- runRWST f (e, fe) (IntSingle 1)
-    return (a, xml, enc)
-
-{- FIXME
--- | 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
+-- FIXME import Yesod.Form.Class
diff --git a/Yesod/Form/Core.hs b/Yesod/Form/Core.hs
deleted file mode 100644
index 59c065fb..00000000
--- a/Yesod/Form/Core.hs
+++ /dev/null
@@ -1,298 +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
-    {- FIXME
-    , deeperFormIdent
-    , shallowerFormIdent
-    -}
-    , Env
-    , FileEnv
-    , Enctype (..)
-    , Ints (..)
-    , requiredFieldHelper
-    , optionalFieldHelper
-    , mapFormXml
-    {- FIXME
-    , checkForm
-    , checkField
-    -}
-    , askParams
-    , askFiles
-      -- * Data types
-    , FieldInfo (..)
-    , FormFieldSettings (..)
-    , FieldProfile (..)
-      -- * Type synonyms
-    {- FIXME
-    , Form
-    , Formlet
-    , FormField
-    , FormletField
-    , FormInput
-    -}
-    ) where
-
-import Control.Monad.Trans.RWS
-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 '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 = 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
-
-type GForm xml m a = RWST (Env, FileEnv) (Enctype, xml) Ints m a -- FIXME rename to Form
-type Env = [(Text, Text)]
-type FileEnv = [(Text, FileInfo)]
-
--- | Get a unique identifier.
-newFormIdent :: (Monoid xml, Monad m) => GForm xml m Text
-newFormIdent = do
-    i <- get
-    let i' = incrInts i
-    put i'
-    return $ pack $ 'f' : show i'
-
-{- FIXME
-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
--}
-
--- | Create a required field (ie, one that cannot be blank) from a
--- 'FieldProfile'.
-requiredFieldHelper
-    :: (Monoid xml', Monad m)
-    => FieldProfile xml a
-    -> FormFieldSettings
-    -> Maybe a
-    -> GForm xml' m (FormResult a, FieldInfo xml)
-requiredFieldHelper (FieldProfile parse render mkWidget) ffs orig = do
-    env <- askParams
-    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"], "") -- TRANS
-                        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)
-
--- | Create an optional field (ie, one that can be blank) from a
--- 'FieldProfile'.
-optionalFieldHelper
-    :: (Monad m, Monoid xml')
-    => FieldProfile xml b
-    -> FormFieldSettings
-    -> Maybe (Maybe b)
-    -> GForm xml' m (FormResult (Maybe b), FieldInfo xml)
-optionalFieldHelper (FieldProfile parse render mkWidget) ffs orig' = do
-    env <- askParams
-    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)
-
--- | Convert the XML in a 'GForm'.
-mapFormXml :: Monad m => (xml1 -> xml2) -> GForm xml1 m a -> GForm xml2 m a
-mapFormXml f = mapRWST $ \x -> do
-    (a, b, (c, d)) <- x
-    return (a, b, (c, f d))
-
--- | 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 xml = FieldInfo
-    { fiLabel :: Html
-    , fiTooltip :: Html
-    , fiIdent :: Text
-    , fiInput :: xml
-    , 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 xml a = FieldProfile
-    { fpParse :: Text -> Either Text a
-    , fpRender :: a -> Text
-    -- | ID, name, value, required
-    , fpWidget :: Text -> Text -> Text -> Bool -> xml
-    }
-
-{- FIXME
-type Form sub y = GForm sub y (GWidget sub y ())
-type Formlet sub y a = Maybe a -> Form sub y a
-type FormInput sub y = GForm sub y [GWidget sub y ()]
-type FormField xml m = GForm xml m [FieldInfo xml]
-type FormletField xml m a = Maybe a -> FormField xml a
--}
-
-{- FIXME
--- | 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 form = 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 :: (Monoid xml, Monad m) => GForm xml m Env
-askParams = liftM fst ask
-
-askFiles :: (Monoid xml, Monad m) => GForm xml m FileEnv
-askFiles = liftM snd ask
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
index 78adf44d..c8c1a6f0 100644
--- a/Yesod/Form/Jquery.hs
+++ b/Yesod/Form/Jquery.hs
@@ -8,20 +8,15 @@
 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.Form
 import Yesod.Widget
 import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
                   timeToTimeOfDay)
@@ -68,18 +63,15 @@ class YesodJquery a where
     urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
     urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
 
-jqueryDayField = requiredFieldHelper . jqueryDayFieldProfile
-
-maybeJqueryDayField = optionalFieldHelper . jqueryDayFieldProfile
-
-jqueryDayFieldProfile jds = FieldProfile
-    { fpParse = maybe
+jqueryDayField :: (YesodJquery master) => JqueryDaySettings -> Field (GWidget sub master ()) Day
+jqueryDayField jds = Field
+    { fieldParse = maybe
                   (Left "Invalid day, must be in YYYY-MM-DD format")
                   Right
               . readMay
               . unpack
-    , fpRender = pack . show
-    , fpWidget = \theId name val isReq -> do
+    , fieldRender = pack . show
+    , fieldView = \theId name val isReq -> do
         addHtml [HAMLET|\
 <input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
 |]
@@ -116,8 +108,6 @@ ifRight e f = case e of
 showLeadingZero :: (Show a) => a -> String
 showLeadingZero time = let t = show time in if length t == 1 then "0" ++ t else t
 
-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) =
@@ -128,10 +118,11 @@ jqueryDayTimeUTCTime (UTCTime day utcTime) =
       let (h, apm) = if hour < 12 then (hour, "AM") else (hour - 12, "PM")
       in (show h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
 
-jqueryDayTimeFieldProfile = FieldProfile
-    { fpParse  = parseUTCTime . unpack
-    , fpRender = pack . jqueryDayTimeUTCTime
-    , fpWidget = \theId name val isReq -> do
+jqueryDayTimeField :: YesodJquery master => Field (GWidget sub master ()) UTCTime
+jqueryDayTimeField = Field
+    { fieldParse  = parseUTCTime . unpack
+    , fieldRender = pack . jqueryDayTimeUTCTime
+    , fieldView = \theId name val isReq -> do
         addHtml [HAMLET|\
 <input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
 |]
@@ -154,16 +145,11 @@ parseUTCTime s =
                 ifRight (parseTime timeS)
                     (UTCTime date . timeOfDayToTime)
 
-jqueryAutocompleteField = requiredFieldHelper . jqueryAutocompleteFieldProfile
-
-maybeJqueryAutocompleteField src =
-    optionalFieldHelper $ jqueryAutocompleteFieldProfile src
-
-jqueryAutocompleteFieldProfile :: YesodJquery master => Route master -> FieldProfile (GWidget sub master ()) Text
-jqueryAutocompleteFieldProfile src = FieldProfile
-    { fpParse = Right
-    , fpRender = id
-    , fpWidget = \theId name val isReq -> do
+jqueryAutocompleteField :: YesodJquery master => Route master -> Field (GWidget sub master ()) 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>
 |]
@@ -175,6 +161,7 @@ $(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
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
index bd2bce58..e98428b7 100644
--- a/Yesod/Form/Nic.hs
+++ b/Yesod/Form/Nic.hs
@@ -8,11 +8,10 @@
 module Yesod.Form.Nic
     ( YesodNic (..)
     , nicHtmlField
-    , maybeNicHtmlField
     ) where
 
 import Yesod.Handler
-import Yesod.Form.Core
+import Yesod.Form
 import Yesod.Widget
 import Text.HTML.SanitizeXSS (sanitizeBalance)
 import Text.Hamlet (Html, hamlet)
@@ -27,15 +26,11 @@ class YesodNic a where
     urlNicEdit :: a -> Either (Route a) Text
     urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
 
-nicHtmlField = requiredFieldHelper nicHtmlFieldProfile
-
-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
+nicHtmlField :: YesodNic master => Field (GWidget sub master ()) Html
+nicHtmlField = Field
+    { fieldParse = Right . preEscapedString . sanitizeBalance . unpack -- FIXME
+    , fieldRender = pack . renderHtml
+    , fieldView = \theId name val _isReq -> do
         addHtml
 #if __GLASGOW_HASKELL__ >= 700
                 [hamlet|
diff --git a/yesod-form.cabal b/yesod-form.cabal
index 9d8e494a..e8087dab 100644
--- a/yesod-form.cabal
+++ b/yesod-form.cabal
@@ -29,15 +29,16 @@ library
                    , 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.Core
+                     Yesod.Form.Types
+                     Yesod.Form.Functions
                      Yesod.Form.Fields
                      Yesod.Form.Jquery
                      Yesod.Form.Nic
-                     Yesod.Form.Profiles
                      -- FIXME Yesod.Helpers.Crud
-    ghc-options:     -Wall
+    ghc-options:     -Wall -Werror
 
 source-repository head
   type:     git