From f3f55a1ecdfbbb0f61047f80b62a1f9dcfb7561d Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 11 Mar 2013 10:54:26 +0200
Subject: [PATCH] RepHtml is a synonym for Html

---
 yesod-core/Yesod/Content.hs    | 12 +-----------
 yesod-core/Yesod/Core/Types.hs |  2 +-
 yesod-core/Yesod/Handler.hs    | 24 ++++++++++++++----------
 yesod-core/Yesod/Widget.hs     |  5 ++---
 4 files changed, 18 insertions(+), 25 deletions(-)

diff --git a/yesod-core/Yesod/Content.hs b/yesod-core/Yesod/Content.hs
index 383a54c1..2c3ea2b7 100644
--- a/yesod-core/Yesod/Content.hs
+++ b/yesod-core/Yesod/Content.hs
@@ -37,12 +37,11 @@ module Yesod.Content
     , ToTypedContent (..)
     , HasContentType (..)
       -- ** Specific content types
-    , RepHtml (..)
+    , RepHtml
     , RepJson (..)
     , RepPlain (..)
     , RepXml (..)
       -- ** Smart constructors
-    , repHtml
     , repJson
     , repPlain
     , repXml
@@ -120,9 +119,6 @@ instance ToFlushBuilder Builder where toFlushBuilder = Chunk
 instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap fromByteString
 instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . fromByteString
 
-repHtml :: ToContent a => a -> RepHtml
-repHtml = RepHtml . toContent
-
 repJson :: ToContent a => a -> RepJson
 repJson = RepJson . toContent
 
@@ -135,10 +131,6 @@ repXml = RepXml . toContent
 class ToTypedContent a => HasContentType a where
     getContentType :: Monad m => m a -> ContentType
 
-instance HasContentType RepHtml where
-    getContentType _ = typeHtml
-deriving instance ToContent RepHtml
-
 instance HasContentType RepJson where
     getContentType _ = typeJson
 deriving instance ToContent RepJson
@@ -240,8 +232,6 @@ instance ToTypedContent () where
     toTypedContent () = TypedContent typePlain (toContent ())
 instance ToTypedContent (ContentType, Content) where
     toTypedContent (ct, content) = TypedContent ct content
-instance ToTypedContent RepHtml where
-    toTypedContent (RepHtml c) = TypedContent typeHtml c
 instance ToTypedContent RepJson where
     toTypedContent (RepJson c) = TypedContent typeJson c
 instance ToTypedContent RepPlain where
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index 5e649e66..669fa141 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -251,7 +251,7 @@ data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content an
 
 data TypedContent = TypedContent !ContentType !Content
 
-newtype RepHtml = RepHtml Content
+type RepHtml = Html
 newtype RepJson = RepJson Content
 newtype RepPlain = RepPlain Content
 newtype RepXml = RepXml Content
diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs
index 04e85740..6e07dea0 100644
--- a/yesod-core/Yesod/Handler.hs
+++ b/yesod-core/Yesod/Handler.hs
@@ -112,8 +112,8 @@ module Yesod.Handler
     , getMessage
       -- * Helpers for specific content
       -- ** Hamlet
-    , hamletToContent
     , hamletToRepHtml
+    , giveUrlRenderer
       -- ** Misc
     , newIdent
       -- * Lifting
@@ -689,16 +689,20 @@ $doctype 5
             <input type="submit" value="Continue">
 |] >>= sendResponse
 
--- | Converts the given Hamlet template into 'Content', which can be used in a
--- Yesod 'Response'.
-hamletToContent :: HandlerReader m => HtmlUrl (Route (HandlerMaster m)) -> m Content
-hamletToContent h = do
-    render <- getUrlRenderParams
-    return $ toContent $ h render
-
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml :: HandlerReader m => HtmlUrl (Route (HandlerMaster m)) -> m RepHtml
-hamletToRepHtml = liftM RepHtml . hamletToContent
+hamletToRepHtml :: HandlerReader m => HtmlUrl (Route (HandlerMaster m)) -> m Html
+hamletToRepHtml = giveUrlRenderer
+
+-- | Provide a URL rendering function to the given function and return the
+-- result. Useful for processing Shakespearean templates.
+--
+-- Since 1.2.0
+giveUrlRenderer :: HandlerReader m
+                => ((Route (HandlerMaster m) -> [(Text, Text)] -> Text) -> output)
+                -> m output
+giveUrlRenderer f = do
+    render <- getUrlRenderParams
+    return $ f render
 
 -- | Get the request\'s 'W.Request' value.
 waiRequest :: HandlerReader m => m W.Request
diff --git a/yesod-core/Yesod/Widget.hs b/yesod-core/Yesod/Widget.hs
index 62c54174..c0099e49 100644
--- a/yesod-core/Yesod/Widget.hs
+++ b/yesod-core/Yesod/Widget.hs
@@ -54,7 +54,6 @@ import Yesod.Routes.Class
 import Yesod.Handler (getMessageRender, getUrlRenderParams)
 import Yesod.Core.Trans.Class (lift)
 import Text.Shakespeare.I18N (RenderMessage)
-import Yesod.Content (toContent)
 import Control.Monad (liftM)
 import Data.Text (Text)
 import qualified Data.Map as Map
@@ -217,11 +216,11 @@ rules = do
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
 ihamletToRepHtml :: RenderMessage master message
                  => HtmlUrlI18n message (Route master)
-                 -> GHandler sub master RepHtml
+                 -> GHandler sub master Html
 ihamletToRepHtml ih = do
     urender <- getUrlRenderParams
     mrender <- getMessageRender
-    return $ RepHtml $ toContent $ ih (toHtml . mrender) urender
+    return $ ih (toHtml . mrender) urender
 
 tell :: GWData (Route master) -> GWidget sub master ()
 tell w = GWidget $ return ((), w)