From 7568bec3c44449f4d31711cff29b3aeb12582d1a Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 9 Jun 2010 09:28:26 +0300
Subject: [PATCH] ToContent typeclass

---
 Yesod/Content.hs | 37 ++++++++++++++++++++-----------------
 Yesod/Handler.hs | 10 +++++-----
 2 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/Yesod/Content.hs b/Yesod/Content.hs
index 8e2f6278..7b32e414 100644
--- a/Yesod/Content.hs
+++ b/Yesod/Content.hs
@@ -9,7 +9,8 @@
 module Yesod.Content
     ( -- * Content
       Content (..)
-    , toContent
+    , emptyContent
+    , ToContent (..)
       -- * Mime types
       -- ** Data type
     , ContentType
@@ -82,22 +83,24 @@ data Content = ContentFile FilePath
                           -> a
                           -> IO (Either a a))
 
-instance ConvertSuccess B.ByteString Content where
-    convertSuccess bs = ContentEnum $ \f a -> f a bs
-instance ConvertSuccess L.ByteString Content where
-    convertSuccess = swapEnum . WE.fromLBS
-instance ConvertSuccess T.Text Content where
-    convertSuccess t = cs (cs t :: B.ByteString)
-instance ConvertSuccess Text Content where
-    convertSuccess lt = cs (cs lt :: L.ByteString)
-instance ConvertSuccess String Content where
-    convertSuccess s = cs (cs s :: Text)
-instance ConvertSuccess (IO Text) Content where
-    convertSuccess = swapEnum . WE.fromLBS' . fmap cs
+emptyContent :: Content
+emptyContent = ContentEnum $ \_ -> return . Right
 
--- | A synonym for 'convertSuccess' to make the desired output type explicit.
-toContent :: ConvertSuccess x Content => x -> Content
-toContent = cs
+class ToContent a where
+    toContent :: a -> Content
+
+instance ToContent B.ByteString where
+    toContent bs = ContentEnum $ \f a -> f a bs
+instance ToContent L.ByteString where
+    toContent = swapEnum . WE.fromLBS
+instance ToContent T.Text where
+    toContent t = toContent (cs t :: B.ByteString)
+instance ToContent Text where
+    toContent lt = toContent (cs lt :: L.ByteString)
+instance ToContent String where
+    toContent s = toContent (cs s :: L.ByteString)
+instance ToContent (IO Text) where
+    toContent = swapEnum . WE.fromLBS' . fmap cs
 
 -- | A function which gives targetted representations of content based on the
 -- content-types the user accepts.
@@ -135,7 +138,7 @@ instance HasReps ChooseRep where
     chooseRep = id
 
 instance HasReps () where
-    chooseRep = defChooseRep [(typePlain, const $ return $ cs "")]
+    chooseRep = defChooseRep [(typePlain, const $ return $ toContent "")]
 
 instance HasReps [(ContentType, Content)] where
     chooseRep a cts = return $
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
index 40112214..5364398e 100644
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -224,9 +224,8 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
             (_, hs, ct, c, sess) <- unYesodApp (eh e) safeEh rr cts
             let hs' = headers ++ hs
             return (getStatus e, hs', ct, c, sess)
-    let sendFile' ct fp = do
-            c <- BL.readFile fp
-            return (W.Status200, headers, ct, cs c, finalSession)
+    let sendFile' ct fp =
+            return (W.Status200, headers, ct, ContentFile fp, finalSession)
     case contents of
         HCContent a -> do
             (ct, c) <- chooseRep a cts
@@ -234,7 +233,8 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
         HCError e -> handleError e
         HCRedirect rt loc -> do
             let hs = Header "Location" loc : headers
-            return (getRedirectStatus rt, hs, typePlain, cs "", finalSession)
+            return (getRedirectStatus rt, hs, typePlain, emptyContent,
+                    finalSession)
         HCSendFile ct fp -> E.catch
             (sendFile' ct fp)
             (handleError . toErrorHandler)
@@ -242,7 +242,7 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
 safeEh :: ErrorResponse -> YesodApp
 safeEh er = YesodApp $ \_ _ _ -> do
     liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
-    return (W.Status500, [], typePlain, cs "Internal Server Error", [])
+    return (W.Status500, [], typePlain, toContent "Internal Server Error", [])
 
 -- | Redirect to the given route.
 redirect :: RedirectType -> Routes master -> GHandler sub master a