diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md index 2da756e7..c38a49dc 100644 --- a/yesod-form/ChangeLog.md +++ b/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) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index d82d8102..3a937ab6 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/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 - -> FieldSettings site - -> Maybe a + => Field m a -- ^ form field + -> FieldSettings site -- ^ settings for this field + -> 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 diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 42dc4c31..674f1f36 100644 --- a/yesod-form/yesod-form.cabal +++ b/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 diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 77957d9c..d58a96e2 100644 --- a/yesod-test/test/main.hs +++ b/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