如何編寫檢查兩個文件是否相同的Yesod表單？

Question

比方說，我們有這樣的事情：

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? 

Answer 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