From d7832b0535047cab651017b666c5415f3619f254 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 15 Sep 2010 11:44:42 +0200
Subject: [PATCH] EscapedHtml

---
 Yesod/Form/Class.hs    |  7 ++++++-
 Yesod/Form/Fields.hs   |  8 ++++++++
 Yesod/Form/Profiles.hs | 19 +++++++++++++++++++
 yesod.cabal            |  2 +-
 4 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/Yesod/Form/Class.hs b/Yesod/Form/Class.hs
index 290b15d7..1b77eb2e 100644
--- a/Yesod/Form/Class.hs
+++ b/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
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
index 611df896..58b838b1 100644
--- a/Yesod/Form/Fields.hs
+++ b/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
 
diff --git a/Yesod/Form/Profiles.hs b/Yesod/Form/Profiles.hs
index 521a7cd1..f8c73347 100644
--- a/Yesod/Form/Profiles.hs
+++ b/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
diff --git a/yesod.cabal b/yesod.cabal
index cc909a60..25533e8b 100644
--- a/yesod.cabal
+++ b/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>