New identifyForm function (fixes #649).
Based on code from @axel-angel but rewritten in a more lightweight style (IMHO, at least :).
This commit is contained in:
parent
a7a7764c97
commit
68d0142dda
@ -24,6 +24,8 @@ module Yesod.Form.Functions
|
|||||||
-- * Generate a blank form
|
-- * Generate a blank form
|
||||||
, generateFormPost
|
, generateFormPost
|
||||||
, generateFormGet
|
, generateFormGet
|
||||||
|
-- * More than one form on a handler
|
||||||
|
, identifyForm
|
||||||
-- * Rendering
|
-- * Rendering
|
||||||
, FormRender
|
, FormRender
|
||||||
, renderTable
|
, renderTable
|
||||||
@ -45,7 +47,7 @@ module Yesod.Form.Functions
|
|||||||
import Yesod.Form.Types
|
import Yesod.Form.Types
|
||||||
import Data.Text (Text, pack)
|
import Data.Text (Text, pack)
|
||||||
import Control.Arrow (second)
|
import Control.Arrow (second)
|
||||||
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
|
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local)
|
||||||
import Control.Monad.Trans.Class
|
import Control.Monad.Trans.Class
|
||||||
import Control.Monad (liftM, join)
|
import Control.Monad (liftM, join)
|
||||||
import Crypto.Classes (constTimeEq)
|
import Crypto.Classes (constTimeEq)
|
||||||
@ -285,6 +287,60 @@ getHelper form env = do
|
|||||||
m <- getYesod
|
m <- getYesod
|
||||||
runFormGeneric (form fragment) m langs env
|
runFormGeneric (form fragment) m langs env
|
||||||
|
|
||||||
|
|
||||||
|
-- | Creates a hidden field on the form that identifies it. This
|
||||||
|
-- identification is then used to distinguish between /missing/
|
||||||
|
-- and /wrong/ form data when a single handler contains more than
|
||||||
|
-- one form.
|
||||||
|
--
|
||||||
|
-- For instance, if you have the following code on your handler:
|
||||||
|
--
|
||||||
|
-- > ((fooRes, fooWidget), fooEnctype) <- runFormPost fooForm
|
||||||
|
-- > ((barRes, barWidget), barEnctype) <- runFormPost barForm
|
||||||
|
--
|
||||||
|
-- Then replace it with
|
||||||
|
--
|
||||||
|
-- > ((fooRes, fooWidget), fooEnctype) <- runFormPost $ identifyForm "foo" fooForm
|
||||||
|
-- > ((barRes, barWidget), barEnctype) <- runFormPost $ identifyForm "bar" barForm
|
||||||
|
--
|
||||||
|
-- Note that it's your responsibility to ensure that the
|
||||||
|
-- identication strings are unique (using the same one twice on a
|
||||||
|
-- single handler will not generate any errors). This allows you
|
||||||
|
-- to create a variable number of forms and still have them work
|
||||||
|
-- even if their number or order change between the HTML
|
||||||
|
-- generation and the form submission.
|
||||||
|
identifyForm
|
||||||
|
:: Monad m
|
||||||
|
=> Text -- ^ Form identification string.
|
||||||
|
-> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
|
||||||
|
-> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
|
||||||
|
identifyForm identVal form = \fragment -> do
|
||||||
|
-- Create hidden <input>.
|
||||||
|
let fragment' =
|
||||||
|
[shamlet|
|
||||||
|
<input type=hidden name=#{identifyFormKey} value=#{identVal}>
|
||||||
|
#{fragment}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- Check if we got its value back.
|
||||||
|
mp <- askParams
|
||||||
|
let missing =
|
||||||
|
case mp of
|
||||||
|
Just params -> Map.lookup identifyFormKey params /= Just [identVal]
|
||||||
|
Nothing -> True
|
||||||
|
|
||||||
|
-- Run the form proper (with our hidden <input>). If the
|
||||||
|
-- data is missing, then do not provide any params to the
|
||||||
|
-- form, which will turn its result into FormMissing. Also,
|
||||||
|
-- doing this avoids having lots of fields with red errors.
|
||||||
|
let eraseParams | missing = local (\(_, h, l) -> (Nothing, h, l))
|
||||||
|
| otherwise = id
|
||||||
|
eraseParams (form fragment')
|
||||||
|
|
||||||
|
identifyFormKey :: Text
|
||||||
|
identifyFormKey = "_formid"
|
||||||
|
|
||||||
|
|
||||||
type FormRender m a =
|
type FormRender m a =
|
||||||
AForm m a
|
AForm m a
|
||||||
-> Html
|
-> Html
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user