Added checkForm
This commit is contained in:
parent
d0f1c60b63
commit
476926cb68
@ -24,6 +24,8 @@ module Yesod.Form
|
|||||||
-- * Field/form helpers
|
-- * Field/form helpers
|
||||||
, fieldsToTable
|
, fieldsToTable
|
||||||
, fieldsToPlain
|
, fieldsToPlain
|
||||||
|
, checkForm
|
||||||
|
-- * Fields
|
||||||
, module Yesod.Form.Fields
|
, module Yesod.Form.Fields
|
||||||
-- * Template Haskell
|
-- * Template Haskell
|
||||||
, mkToForm
|
, mkToForm
|
||||||
|
|||||||
@ -13,6 +13,7 @@ module Yesod.Form.Core
|
|||||||
, optionalFieldHelper
|
, optionalFieldHelper
|
||||||
, fieldsToInput
|
, fieldsToInput
|
||||||
, mapFormXml
|
, mapFormXml
|
||||||
|
, checkForm
|
||||||
-- * Data types
|
-- * Data types
|
||||||
, FieldInfo (..)
|
, FieldInfo (..)
|
||||||
, FormFieldSettings (..)
|
, 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 FormField sub y = GForm sub y [FieldInfo sub y]
|
||||||
type FormletField sub y a = Maybe a -> FormField sub y a
|
type FormletField sub y a = Maybe a -> FormField sub y a
|
||||||
type FormInput sub y = GForm sub y [GWidget sub y ()]
|
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)
|
||||||
|
|||||||
@ -53,7 +53,6 @@ import Web.Routes.Site (Site)
|
|||||||
import Control.Monad.Trans.Class (MonadTrans (..))
|
import Control.Monad.Trans.Class (MonadTrans (..))
|
||||||
import Control.Monad.Attempt (Failure)
|
import Control.Monad.Attempt (Failure)
|
||||||
import qualified Data.ByteString as S
|
import qualified Data.ByteString as S
|
||||||
import qualified Data.ByteString.Char8 as S8
|
|
||||||
import qualified Network.Wai.Middleware.CleanPath
|
import qualified Network.Wai.Middleware.CleanPath
|
||||||
import Web.Routes (encodePathInfo)
|
import Web.Routes (encodePathInfo)
|
||||||
import qualified Data.ByteString.Lazy as L
|
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 :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
|
||||||
defaultErrorHandler NotFound = do
|
defaultErrorHandler NotFound = do
|
||||||
r <- waiRequest
|
r <- waiRequest
|
||||||
let pi = BSU.toString $ pathInfo r
|
let path = BSU.toString $ pathInfo r
|
||||||
applyLayout' "Not Found" $ [$hamlet|
|
applyLayout' "Not Found" $ [$hamlet|
|
||||||
%h1 Not Found
|
%h1 Not Found
|
||||||
%p $pi$
|
%p $path$
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
pathInfo = W.pathInfo
|
pathInfo = W.pathInfo
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user