Added checkForm

This commit is contained in:
Michael Snoyman 2010-08-15 01:02:15 +03:00
parent d0f1c60b63
commit 476926cb68
3 changed files with 14 additions and 3 deletions

View File

@ -24,6 +24,8 @@ module Yesod.Form
-- * Field/form helpers
, fieldsToTable
, fieldsToPlain
, checkForm
-- * Fields
, module Yesod.Form.Fields
-- * Template Haskell
, mkToForm

View File

@ -13,6 +13,7 @@ module Yesod.Form.Core
, optionalFieldHelper
, fieldsToInput
, mapFormXml
, checkForm
-- * Data types
, FieldInfo (..)
, FormFieldSettings (..)
@ -230,3 +231,12 @@ type Formlet sub y a = Maybe a -> Form sub y a
type FormField sub y = GForm sub y [FieldInfo sub y]
type FormletField sub y a = Maybe a -> FormField sub y a
type FormInput sub y = GForm sub y [GWidget sub y ()]
checkForm :: (a -> FormResult b) -> GForm s m x a -> GForm s m x b
checkForm f (GForm form) = GForm $ \env fenv -> do
(res, xml, enc) <- form env fenv
let res' = case res of
FormSuccess a -> f a
FormFailure e -> FormFailure e
FormMissing -> FormMissing
return (res', xml, enc)

View File

@ -53,7 +53,6 @@ import Web.Routes.Site (Site)
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Attempt (Failure)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Network.Wai.Middleware.CleanPath
import Web.Routes (encodePathInfo)
import qualified Data.ByteString.Lazy as L
@ -268,10 +267,10 @@ applyLayout' s = fmap chooseRep . applyLayout s mempty
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
defaultErrorHandler NotFound = do
r <- waiRequest
let pi = BSU.toString $ pathInfo r
let path = BSU.toString $ pathInfo r
applyLayout' "Not Found" $ [$hamlet|
%h1 Not Found
%p $pi$
%p $path$
|]
where
pathInfo = W.pathInfo