diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 89d1cf9f..b6d38f19 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -50,14 +50,19 @@ module Yesod.Form , maybeDoubleField , dayField , maybeDayField + , jqueryDayField + , maybeJqueryDayField , timeField , maybeTimeField , htmlField , maybeHtmlField + , nicHtmlField + , maybeNicHtmlField , selectField , maybeSelectField , boolField , jqueryAutocompleteField + , maybeJqueryAutocompleteField -- * Pre-built inputs , stringInput , maybeStringInput @@ -322,6 +327,9 @@ instance ToFormField Day where instance ToFormField (Maybe Day) where toFormField = optionalFieldHelper dayFieldProfile +jqueryDayField = requiredFieldHelper jqueryDayFieldProfile +maybeJqueryDayField = optionalFieldHelper jqueryDayFieldProfile + jqueryDayFieldProfile :: FieldProfile sub y JqueryDay jqueryDayFieldProfile = FieldProfile { fpParse = maybe @@ -434,6 +442,9 @@ instance ToFormField (Maybe (Html ())) where newtype NicHtml = NicHtml { unNicHtml :: Html () } deriving PersistField +nicHtmlField = requiredFieldHelper nicHtmlFieldProfile +maybeNicHtmlField = optionalFieldHelper nicHtmlFieldProfile + nicHtmlFieldProfile :: FieldProfile sub y NicHtml nicHtmlFieldProfile = FieldProfile { fpParse = Right . NicHtml . preEscapedString @@ -680,6 +691,8 @@ toLabel (x:rest) = toUpper x : go rest jqueryAutocompleteField src = requiredFieldHelper $ jqueryAutocompleteFieldProfile src +maybeJqueryAutocompleteField src = optionalFieldHelper + $ jqueryAutocompleteFieldProfile src jqueryAutocompleteFieldProfile :: Route y -> FieldProfile sub y String jqueryAutocompleteFieldProfile src = FieldProfile diff --git a/hellowidget.hs b/hellowidget.hs index 5ea9aa77..a223effa 100644 --- a/hellowidget.hs +++ b/hellowidget.hs @@ -40,15 +40,15 @@ handleFormR = do <$> stringField (string "My Field") (string "Some tooltip info") Nothing <*> stringField (string "Another field") (string "") (Just "some default text") <*> intField (string "A number field") (string "some nums") (Just 5) - <*> dayField (string "A day field") (string "") Nothing + <*> jqueryDayField (string "A day field") (string "") Nothing <*> timeField (string "A time field") (string "") Nothing <*> boolField (string "A checkbox") (string "") (Just False) <*> jqueryAutocompleteField AutoCompleteR (string "Autocomplete") (string "Try it!") Nothing - <*> htmlField (string "HTML") (string "") - (Just $ string "You can put rich text here") + <*> nicHtmlField (string "HTML") (string "") + (Just $ NicHtml $ string "You can put rich text here") let mhtml = case res of - FormSuccess (_, _, _, _, _, _, _, x) -> Just x + FormSuccess (_, _, _, _, _, _, _, NicHtml x) -> Just x _ -> Nothing applyLayoutW $ do addStyle [$hamlet|\.tooltip{color:#666;font-style:italic}|]