diff --git a/Yesod/Form.hs b/Yesod/Form.hs index e7c411c6..f2462148 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -24,6 +24,8 @@ module Yesod.Form -- * Field/form helpers , fieldsToTable , fieldsToPlain + , checkForm + -- * Fields , module Yesod.Form.Fields -- * Template Haskell , mkToForm diff --git a/Yesod/Form/Core.hs b/Yesod/Form/Core.hs index 75f4c9e2..e5ddea00 100644 --- a/Yesod/Form/Core.hs +++ b/Yesod/Form/Core.hs @@ -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) diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 06475539..b4c9fb1a 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -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