Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- data Enctype
- data FormResult a
- = FormMissing
- | FormFailure [Text]
- | FormSuccess a
- data FormMessage
- = MsgInvalidInteger Text
- | MsgInvalidNumber Text
- | MsgInvalidEntry Text
- | MsgInvalidUrl Text
- | MsgInvalidEmail Text
- | MsgInvalidTimeFormat
- | MsgInvalidHour Text
- | MsgInvalidMinute Text
- | MsgInvalidSecond Text
- | MsgInvalidDay
- | MsgCsrfWarning
- | MsgValueRequired
- | MsgInputNotFound Text
- | MsgSelectNone
- | MsgInvalidBool Text
- | MsgBoolYes
- | MsgBoolNo
- | MsgDelete
- | MsgInvalidHexColorFormat Text
- | MsgInvalidDatetimeFormat Text
- type Env = Map Text [Text]
- type FileEnv = Map Text [FileInfo]
- data Ints
- type WForm m a = MForm (WriterT [FieldView (HandlerSite m)] m) a
- type MForm m a = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m a
- newtype AForm m a = AForm {
- unAForm :: (HandlerSite m, [Text]) -> Maybe (Env, FileEnv) -> Ints -> m (FormResult a, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints, Enctype)
- data Field m a = Field {
- fieldParse :: [Text] -> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
- fieldView :: FieldViewFunc m a
- fieldEnctype :: Enctype
- data FieldSettings master = FieldSettings {}
- data FieldView site = FieldView {}
- type FieldViewFunc m a = Text -> Text -> [(Text, Text)] -> Either Text a -> Bool -> WidgetFor (HandlerSite m) ()
Helpers
The encoding type required by a form. The ToHtml
instance produces values
that can be inserted directly into HTML.
Instances
Monoid Enctype Source # | |
Semigroup Enctype Source # | |
Bounded Enctype Source # | |
Enum Enctype Source # | |
ToMarkup Enctype Source # | |
Defined in Yesod.Form.Types | |
ToValue Enctype Source # | |
Defined in Yesod.Form.Types toValue :: Enctype -> AttributeValue # | |
Eq Enctype Source # | |
data FormResult a Source #
A form can produce three different results: there was no data available, the data was invalid, or there was a successful parse.
The Applicative
instance will concatenate the failure messages in two
FormResult
s.
The Alternative
instance will choose FormFailure
before FormSuccess
,
and FormMissing
last of all.
Instances
data FormMessage Source #
Instances
Read FormMessage Source # | |
Defined in Yesod.Form.Types readsPrec :: Int -> ReadS FormMessage # readList :: ReadS [FormMessage] # readPrec :: ReadPrec FormMessage # readListPrec :: ReadPrec [FormMessage] # | |
Show FormMessage Source # | |
Defined in Yesod.Form.Types showsPrec :: Int -> FormMessage -> ShowS # show :: FormMessage -> String # showList :: [FormMessage] -> ShowS # | |
Eq FormMessage Source # | |
Defined in Yesod.Form.Types (==) :: FormMessage -> FormMessage -> Bool # (/=) :: FormMessage -> FormMessage -> Bool # |
Form
type WForm m a = MForm (WriterT [FieldView (HandlerSite m)] m) a Source #
MForm
variant stacking a WriterT
. The following code example using a
monadic form MForm
:
formToAForm $ do (field1F, field1V) <- mreq textField MsgField1 Nothing (field2F, field2V) <- mreq (checkWith field1F textField) MsgField2 Nothing (field3F, field3V) <- mreq (checkWith field1F textField) MsgField3 Nothing return ( MyForm <$> field1F <*> field2F <*> field3F , [field1V, field2V, field3V] )
Could be rewritten as follows using WForm
:
wFormToAForm $ do field1F <- wreq textField MsgField1 Nothing field2F <- wreq (checkWith field1F textField) MsgField2 Nothing field3F <- wreq (checkWith field1F textField) MsgField3 Nothing return $ MyForm <$> field1F <*> field2F <*> field3F
Since: 1.4.14
AForm | |
|
Build forms
Field | |
|
data FieldSettings master Source #
Instances
IsString (FieldSettings a) Source # | |
Defined in Yesod.Form.Types fromString :: String -> FieldSettings a # |