ToContent typeclass

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
+emptyContent :: Content
-    convertSuccess bs = ContentEnum $ \f a -> f a bs
+emptyContent = ContentEnum $ \_ -> return . Right
-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
 
--- | A synonym for 'convertSuccess' to make the desired output type explicit.
+class ToContent a where
-toContent :: ConvertSuccess x Content => x -> Content
+    toContent :: a -> Content
-toContent = cs
+
+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 $

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
+    let sendFile' ct fp =
-            c <- BL.readFile fp
+            return (W.Status200, headers, ct, ContentFile fp, finalSession)
-            return (W.Status200, headers, ct, cs c, 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