如何编写Yesod表单来检查两个文件是否相同?

时间:2015-12-06 14:42:35

标签: haskell yesod

假设我们有这样的事情:

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

是否可以检查两个字段是否相同?验证是 描述herecheck 似乎不够强大,不能执行这种检查。也许 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?

1 个答案:

答案 0 :(得分:2)

这是自定义密码字段的工作示例,用于检查两个框中的输入是否相同。此比较在记录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