From 7377919f6c6c6548f57e119da1b8794f9e671c40 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 7 Oct 2010 23:34:02 +0200
Subject: [PATCH] checkField

---
 Yesod/Form/Core.hs | 23 ++++++++++++++++++++++-
 yesod.cabal        |  2 +-
 2 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/Yesod/Form/Core.hs b/Yesod/Form/Core.hs
index 46c81f0d..4661947f 100644
--- a/Yesod/Form/Core.hs
+++ b/Yesod/Form/Core.hs
@@ -190,7 +190,7 @@ optionalFieldHelper (FieldProfile parse render mkWidget) ffs orig' = GForm $ do
             , fiName = name
             , fiInput = mkWidget theId name val False
             , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
+                            FormFailure x -> Just $ string $ unlines x
                             _ -> Nothing
             }
     return (res, [fi], UrlEncoded)
@@ -241,6 +241,7 @@ 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 ()]
 
+-- | FIXME Add some docs, especially about how failures from this function don't show up in the HTML.
 checkForm :: (a -> FormResult b) -> GForm s m x a -> GForm s m x b
 checkForm f (GForm form) = GForm $ do
     (res, xml, enc) <- form
@@ -250,6 +251,26 @@ checkForm f (GForm form) = GForm $ do
                     FormMissing -> FormMissing
     return (res', xml, enc)
 
+checkField :: (a -> Either String 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)
+    let xml' =
+            case merr of
+                Nothing -> xml
+                Just err -> flip map xml $ \fi -> fi
+                    { fiErrors = Just $
+                        case fiErrors fi of
+                            Nothing -> string err
+                            Just x -> x
+                    }
+    return (res', xml', enc)
+
 askParams :: Monad m => StateT Ints (ReaderT Env m) Env
 askParams = lift ask
 
diff --git a/yesod.cabal b/yesod.cabal
index b4038e2d..4129ff7c 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -25,7 +25,7 @@ library
                    , time                      >= 1.1.4    && < 1.3
                    , wai                       >= 0.2.0    && < 0.3
                    , wai-extra                 >= 0.2.2    && < 0.3
-                   , authenticate              >= 0.6.3.2  && < 0.7
+                   , authenticate              >= 0.7      && < 0.8
                    , bytestring                >= 0.9.1.4  && < 0.10
                    , directory                 >= 1        && < 1.2
                    , text                      >= 0.5      && < 0.10