EscapedHtml

Yesod/Form/Class.hs

@@ -9,7 +9,7 @@ module Yesod.Form.Class
 import Text.Hamlet
 import Yesod.Form.Fields
 import Yesod.Form.Core
-import Yesod.Form.Profiles (Textarea)
+import Yesod.Form.Profiles (Textarea, EscapedHtml)
 import Data.Int (Int64)
 import Data.Time (Day, TimeOfDay)
 
@@ -59,3 +59,8 @@ instance ToFormField Textarea y where
     toFormField = textareaField
 instance ToFormField (Maybe Textarea) y where
     toFormField = maybeTextareaField
+
+instance ToFormField EscapedHtml y where
+    toFormField = escapedHtmlField
+instance ToFormField (Maybe EscapedHtml) y where
+    toFormField = maybeEscapedHtmlField

Yesod/Form/Fields.hs

@@ -4,6 +4,7 @@ module Yesod.Form.Fields
       -- ** Required
       stringField
     , textareaField
+    , escapedHtmlField
     , hiddenField
     , intField
     , doubleField
@@ -17,6 +18,7 @@ module Yesod.Form.Fields
       -- ** Optional
     , maybeStringField
     , maybeTextareaField
+    , maybeEscapedHtmlField
     , maybeHiddenField
     , maybeIntField
     , maybeDoubleField
@@ -267,6 +269,12 @@ textareaField = requiredFieldHelper textareaFieldProfile
 maybeTextareaField :: FormFieldSettings -> FormletField sub y (Maybe Textarea)
 maybeTextareaField = optionalFieldHelper textareaFieldProfile
 
+escapedHtmlField :: FormFieldSettings -> FormletField sub y EscapedHtml
+escapedHtmlField = requiredFieldHelper escapedHtmlFieldProfile
+
+maybeEscapedHtmlField :: FormFieldSettings -> FormletField sub y (Maybe EscapedHtml)
+maybeEscapedHtmlField = optionalFieldHelper escapedHtmlFieldProfile
+
 hiddenField :: FormFieldSettings -> FormletField sub y String
 hiddenField = requiredFieldHelper hiddenFieldProfile
 

Yesod/Form/Profiles.hs

@@ -4,6 +4,7 @@
 module Yesod.Form.Profiles
     ( stringFieldProfile
     , textareaFieldProfile
+    , escapedHtmlFieldProfile
     , hiddenFieldProfile
     , intFieldProfile
     , dayFieldProfile
@@ -16,6 +17,7 @@ module Yesod.Form.Profiles
     , parseDate
     , parseTime
     , Textarea (..)
+    , EscapedHtml (..)
     ) where
 
 import Yesod.Form.Core
@@ -110,6 +112,23 @@ textareaFieldProfile = FieldProfile
 |]
     }
 
+-- | A newtype wrapper around a 'Html' that automatically entity-escapes all
+-- input from the user. This means that values stored in the database are
+-- already entity-escaped, avoiding escaping each time it is rendered.
+newtype EscapedHtml = EscapedHtml { unEscapedHtml :: Html }
+    deriving (Show, Eq, PersistField)
+instance ToHtml EscapedHtml where
+    toHtml = unEscapedHtml
+
+escapedHtmlFieldProfile :: FieldProfile sub y EscapedHtml
+escapedHtmlFieldProfile = FieldProfile
+    { fpParse = Right . EscapedHtml . string
+    , fpRender = U.toString . renderHtml . unEscapedHtml
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
+%textarea#$theId$!name=$name$ $val$
+|]
+    }
+
 hiddenFieldProfile :: FieldProfile sub y String
 hiddenFieldProfile = FieldProfile
     { fpParse = Right

yesod.cabal

@@ -1,5 +1,5 @@
 name:            yesod
-version:         0.5.0.4
+version:         0.5.1
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>