如何编写检查两个字段是否相同的 Yesod 表单？答案

【问题标题】：How to write Yesod form that checks if two fileds are the same?如何编写检查两个字段是否相同的 Yesod 表单？
【发布时间】：2016-01-15 22:39:44
【问题描述】：

假设我们有这样的东西：

myForm :: Form (Text, Text)
myForm = renderBootstrap3 BootstrapBasicForm $ (,)
  <$> areq passwordField (bfs ("Password" :: Text)) Nothing
  <*> areq passwordField (bfs ("Repeat password" :: Text)) Nothing

是否可以检查两个字段是否相同？验证是描述here, check 似乎不够强大，无法执行这种检查。也许 checkM 可能有用吗？

如果无法使用内置 Yesod 设施，那将是什么最好的解决方法？我能想到：

postSomethingR :: Handler Html
postSomethingR = do
  ((result, form), enctype) <- runFormPost myForm
  case result of
    FormSuccess (password0, password1) -> do
      if password0 == password1
      then
      -- do your thing
      else
      -- serve the form again and perhaps set message telling that
      -- passwords don't match?

【问题讨论】：

标签： haskell yesod

【解决方案1】：

这是一个自定义密码字段的工作示例，用于检查两个框的输入是否相同。此比较是在记录 fieldParse 中创建的。

要从 cmd 运行此示例：stack runghc <filename.hs>

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Control.Applicative
import           Data.Text           (Text)
import           Yesod

data App = App

mkYesod "App" [parseRoutes|
/ HomeR GET
|]

instance Yesod App

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage


passwordConfirmField :: Field Handler Text
passwordConfirmField = Field
    { fieldParse = \rawVals _fileVals ->
        case rawVals of
            [a, b]
                | a == b -> return $ Right $ Just a
                | otherwise -> return $ Left "Passwords don't match"
            [] -> return $ Right Nothing
            _ -> return $ Left "You must enter two values"
    , fieldView = \idAttr nameAttr otherAttrs eResult isReq ->
        [whamlet|
            <input id=#{idAttr} name=#{nameAttr} *{otherAttrs} type=password>
            <div>Confirm:
            <input id=#{idAttr}-confirm name=#{nameAttr} *{otherAttrs} type=password>
        |]
    , fieldEnctype = UrlEncoded
    }

getHomeR :: Handler Html
getHomeR = do
    ((res, widget), enctype) <- runFormGet $ renderDivs $
        areq passwordConfirmField "Password" Nothing
    defaultLayout
        [whamlet|
            <p>Result: #{show res}
            <form enctype=#{enctype}>
                ^{widget}
                <input type=submit value="Change password">
        |]

main :: IO ()
main = warp 3000 App

【讨论】：

不会像this 这样的东西也能正常工作吗？