Merge pull request #1628 from sestrella/areq_and_wreq_custom_error_message

Customize `areq` and `wreq` error message

yesod-form/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for yesod-form
 
+## 1.6.7
+
+* Added equivalent version of `mreqMsg` for `areq` and `wreq` correspondingly [#1628](https://github.com/yesodweb/yesod/pull/1628)
+
 ## 1.6.6
 
 * Added `mreqMsg` for `mreq` functionality with a configurable MsgValueRequired [#1613](https://github.com/yesodweb/yesod/pull/1613)

yesod-form/Yesod/Form/Functions.hs

@@ -18,11 +18,13 @@ module Yesod.Form.Functions
     , wFormToMForm
       -- * Fields to Forms
     , wreq
+    , wreqMsg
     , wopt
     , mreq
     , mreqMsg
     , mopt
     , areq
+    , areqMsg
     , aopt
       -- * Run a form
     , runFormPost
@@ -124,7 +126,23 @@ wreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
      -> FieldSettings site  -- ^ settings for this field
      -> Maybe a             -- ^ optional default value
      -> WForm m (FormResult a)
-wreq f fs = mFormToWForm . mreq f fs
+wreq f fs = wreqMsg f fs MsgValueRequired
+
+-- | Same as @wreq@ but with your own message to be rendered in case the value
+-- is not provided.
+--
+-- This is useful when you have several required fields on the page and you
+-- want to differentiate between which fields were left blank. Otherwise the
+-- user sees "Value is required" multiple times, which is ambiguous.
+--
+-- @since 1.6.7
+wreqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
+        => Field m a           -- ^ form field
+        -> FieldSettings site  -- ^ settings for this field
+        -> msg                 -- ^ message to use in case value is Nothing
+        -> Maybe a             -- ^ optional default value
+        -> WForm m (FormResult a)
+wreqMsg f fs msg = mFormToWForm . mreqMsg f fs msg
 
 -- | Converts a form field into monadic form 'WForm'. This field is optional,
 -- i.e.  if filled in, it returns 'Just a', if left empty, it returns
@@ -247,11 +265,27 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
 
 -- | Applicative equivalent of 'mreq'.
 areq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
-     => Field m a
+     => Field m a           -- ^ form field
-     -> FieldSettings site
+     -> FieldSettings site  -- ^ settings for this field
-     -> Maybe a
+     -> Maybe a             -- ^ optional default value
      -> AForm m a
-areq a b = formToAForm . liftM (second return) . mreq a b
+areq f fs = areqMsg f fs MsgValueRequired
+
+-- | Same as @areq@ but with your own message to be rendered in case the value
+-- is not provided.
+--
+-- This is useful when you have several required fields on the page and you
+-- want to differentiate between which fields were left blank. Otherwise the
+-- user sees "Value is required" multiple times, which is ambiguous.
+--
+-- @since 1.6.7
+areqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
+        => Field m a           -- ^ form field
+        -> FieldSettings site  -- ^ settings for this field
+        -> msg                 -- ^ message to use in case value is Nothing
+        -> Maybe a             -- ^ optional default value
+        -> AForm m a
+areqMsg f fs msg = formToAForm . liftM (second return) . mreqMsg f fs msg
 
 -- | Applicative equivalent of 'mopt'.
 aopt :: MonadHandler m

yesod-form/yesod-form.cabal

@@ -1,5 +1,5 @@
 name:            yesod-form
-version:         1.6.6
+version:         1.6.7
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

yesod-test/test/main.hs

@@ -206,6 +206,37 @@ main = hspec $ do
               bad <- tryAny (clickOn "a#nonexistentlink")
               assertEq "bad link" (isLeft bad) True
 
+        ydescribe "custom error message" $ do
+            yit "returns the message pass to areqMsg" $ do
+                get ("/form" :: Text)
+                statusIs 200
+
+                request $ do
+                    setMethod "POST"
+                    setUrl ("/form" :: Text)
+                    addToken
+                statusIs 200
+                htmlAnyContain ".errors" "Missing Label"
+            yit "returns the message pass to mreqMsg" $ do
+                get ("/mform" :: Text)
+                statusIs 200
+
+                request $ do
+                    setMethod "POST"
+                    setUrl ("/mform" :: Text)
+                    addToken
+                statusIs 200
+                htmlAnyContain ".errors" "Missing MLabel"
+            yit "returns the message pass to wreqMsg" $ do
+                get ("/wform" :: Text)
+                statusIs 200
+
+                request $ do
+                    setMethod "POST"
+                    setUrl ("/wform" :: Text)
+                    addToken
+                statusIs 200
+                htmlAnyContain ".errors" "Missing WLabel"
 
         ydescribe "utf8 paths" $ do
             yit "from path" $ do
@@ -439,14 +470,26 @@ app = liteApp $ do
         ((mfoo, widget), _) <- runFormPost
                         $ renderDivs
                         $ (,)
-                      Control.Applicative.<$> areq textField "Some Label" Nothing
+                      Control.Applicative.<$> areqMsg textField "Some Label" ("Missing Label" :: SomeMessage LiteApp) Nothing
                       <*> areq fileField "Some File" Nothing
         case mfoo of
             FormSuccess (foo, _) -> return $ toHtml foo
             _ -> defaultLayout widget
+    onStatic "mform" $ dispatchTo $ do
+        ((mfoo, widget), _) <- runFormPost $ renderDivs $ formToAForm $ do
+          (field1F, field1V) <- mreqMsg textField "Some MLabel" ("Missing MLabel" :: SomeMessage LiteApp) Nothing
+          (field2F, field2V) <- mreq fileField "Some MFile" Nothing
+
+          return
+            ( (,) Control.Applicative.<$> field1F <*> field2F
+            , [field1V, field2V]
+            )
+        case mfoo of
+            FormSuccess (foo, _) -> return $ toHtml foo
+            _                    -> defaultLayout widget
     onStatic "wform" $ dispatchTo $ do
         ((mfoo, widget), _) <- runFormPost $ renderDivs $ wFormToAForm $ do
-          field1F <- wreq textField "Some WLabel" Nothing
+          field1F <- wreqMsg textField "Some WLabel" ("Missing WLabel" :: SomeMessage LiteApp) Nothing
           field2F <- wreq fileField "Some WFile" Nothing
 
           return $ (,) Control.Applicative.<$> field1F <*> field2F