Fancy form widgets

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

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}|]