Began major refactoring of code

Yesod/Dispatch.hs

@@ -32,15 +32,34 @@ import System.Environment (getEnvironment)
 
 import qualified Data.ByteString.Char8 as B
 import Data.Maybe (fromMaybe)
-import Web.Encodings (parseHttpAccept)
+import Web.Encodings
 import Web.Mime
 import Data.List (intercalate)
 import Web.Routes (encodePathInfo, decodePathInfo)
 
-mkYesod :: String -> [Resource] -> Q [Dec]
+import Control.Concurrent.MVar
+import Control.Arrow ((***))
+import Data.Convertible.Text (cs)
+
+import Data.Time.Clock
+
+-- | Generates URL datatype and site function for the given 'Resource's. This
+-- is used for creating sites, *not* subsites. See 'mkYesodSub' for the latter.
+-- Use 'parseRoutes' in generate to create the 'Resource's.
+mkYesod :: String -- ^ name of the argument datatype
+        -> [Resource]
+        -> Q [Dec]
 mkYesod name = mkYesodGeneral name [] False
 
-mkYesodSub :: String -> [Name] -> [Resource] -> Q [Dec]
+-- | Generates URL datatype and site function for the given 'Resource's. This
+-- is used for creating subsites, *not* sites. See 'mkYesod' for the latter.
+-- Use 'parseRoutes' in generate to create the 'Resource's. In general, a
+-- subsite is not executable by itself, but instead provides functionality to
+-- be embedded in other sites.
+mkYesodSub :: String -- ^ name of the argument datatype
+           -> [Name] -- ^ a list of classes the master datatype must be an instance of
+           -> [Resource]
+           -> Q [Dec]
 mkYesodSub name clazzes = mkYesodGeneral name clazzes True
 
 explodeHandler :: HasReps c
@@ -74,6 +93,8 @@ mkYesodGeneral name clazzes isSub res = do
                 }
     return $ (if isSub then id else (:) yes) [w, x, y, z]
 
+-- | Convert the given argument into a WAI application, executable with any WAI
+-- handler. You can use 'basicHandler' if you wish.
 toWaiApp :: Yesod y => y -> IO W.Application
 toWaiApp a = do
     key' <- encryptKey a
@@ -82,7 +103,7 @@ toWaiApp a = do
            $ jsonp
            $ methodOverride
            $ cleanPath
-           $ \thePath -> clientsession encryptedCookies key' mins
+           $ \thePath -> clientsession encryptedCookies key' mins -- FIXME allow user input for encryptedCookies
            $ toWaiApp' a thePath
 
 toWaiApp' :: Yesod y
@@ -91,7 +112,7 @@ toWaiApp' :: Yesod y
           -> [(B.ByteString, B.ByteString)]
           -> W.Request
           -> IO W.Response
-toWaiApp' y resource session env = do
+toWaiApp' y resource session' env = do
     let site = getSite
         method = B.unpack $ W.methodToBS $ W.requestMethod env
         types = httpAccept env
@@ -99,7 +120,7 @@ toWaiApp' y resource session env = do
         eurl = quasiParse site pathSegments
         render u = approot y ++ '/'
                  : encodePathInfo (fixSegs $ quasiRender site u)
-    rr <- parseWaiRequest env session
+    rr <- parseWaiRequest env session'
     onRequest y rr
     print pathSegments -- FIXME remove
     let ya = case eurl of
@@ -153,3 +174,62 @@ fixSegs [x]
     | any (== '.') x = [x]
     | otherwise = [x, ""] -- append trailing slash
 fixSegs (x:xs) = x : fixSegs xs
+
+parseWaiRequest :: W.Request
+                -> [(B.ByteString, B.ByteString)] -- ^ session
+                -> IO Request
+parseWaiRequest env session' = do
+    let gets' = map (cs *** cs) $ decodeUrlPairs $ W.queryString env
+    let reqCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env
+        cookies' = map (cs *** cs) $ parseCookies reqCookie
+        acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env
+        langs = map cs $ maybe [] parseHttpAccept acceptLang
+        langs' = case lookup langKey cookies' of
+                    Nothing -> langs
+                    Just x -> x : langs
+        langs'' = case lookup langKey gets' of
+                     Nothing -> langs'
+                     Just x -> x : langs'
+        session'' = map (cs *** cs) session'
+    rbthunk <- iothunk $ rbHelper env
+    return $ Request gets' cookies' session'' rbthunk env langs''
+
+rbHelper :: W.Request -> IO RequestBodyContents
+rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where
+    fix1 = map (cs *** cs)
+    fix2 (x, FileInfo a b c) = (cs x, FileInfo (cs a) (cs b) c)
+
+-- | Produces a \"compute on demand\" value. The computation will be run once
+-- it is requested, and then the result will be stored. This will happen only
+-- once.
+iothunk :: IO a -> IO (IO a)
+iothunk = fmap go . newMVar . Left where
+    go :: MVar (Either (IO a) a) -> IO a
+    go mvar = modifyMVar mvar go'
+    go' :: Either (IO a) a -> IO (Either (IO a) a, a)
+    go' (Right val) = return (Right val, val)
+    go' (Left comp) = do
+        val <- comp
+        return (Right val, val)
+
+responseToWaiResponse :: (W.Status, [Header], ContentType, Content)
+                      -> IO W.Response
+responseToWaiResponse (sc, hs, ct, c) = do
+    hs' <- mapM headerToPair hs
+    let hs'' = (W.ContentType, cs $ contentTypeToString ct) : hs'
+    return $ W.Response sc hs'' $ case c of
+                                    ContentFile fp -> Left fp
+                                    ContentEnum e -> Right $ W.Enumerator e
+
+-- | Convert Header to a key/value pair.
+headerToPair :: Header -> IO (W.ResponseHeader, B.ByteString)
+headerToPair (AddCookie minutes key value) = do
+    now <- getCurrentTime
+    let expires = addUTCTime (fromIntegral $ minutes * 60) now
+    return (W.SetCookie, cs $ key ++ "=" ++ value ++"; path=/; expires="
+                              ++ formatW3 expires)
+headerToPair (DeleteCookie key) = return
+    (W.SetCookie, cs $
+     key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
+headerToPair (Header key value) =
+    return (W.responseHeaderFromBS $ cs key, cs value)

Yesod/Hamlet.hs

@@ -1,15 +1,20 @@
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Yesod.Hamlet
-    ( hamletToContent
+    ( -- * Hamlet library
-    , hamletToRepHtml
+      Hamlet
-    , PageContent (..)
-    , Hamlet
     , hamlet
     , HtmlContent (..)
+      -- * Convert to something displayable
+    , hamletToContent
+    , hamletToRepHtml
+      -- * Page templates
+    , PageContent (..)
+      -- * data-object
     , HtmlObject
     )
     where
@@ -22,12 +27,19 @@ import Data.Convertible.Text
 import Data.Object
 import Control.Arrow ((***))
 
+-- | Content for a web page. By providing this datatype, we can easily create
+-- generic site templates, which would have the type signature:
+--
+-- > PageContent url -> Hamlet url IO ()
 data PageContent url = PageContent
     { pageTitle :: HtmlContent
     , pageHead :: Hamlet url IO ()
     , pageBody :: Hamlet url IO ()
     }
 
+-- FIXME some typeclasses for the stuff below?
+-- | Converts the given Hamlet template into 'Content', which can be used in a
+-- Yesod 'Response'.
 hamletToContent :: Hamlet (Routes sub) IO () -> GHandler sub master Content
 hamletToContent h = do
     render <- getUrlRender
@@ -40,16 +52,9 @@ hamletToContent h = do
             Right ((), x) -> return $ Right x
     iter' iter seed text = iter seed $ cs text
 
-hamletToRepHtml :: Hamlet (Routes y) IO () -> Handler y RepHtml
+-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml h = do
+hamletToRepHtml :: Hamlet (Routes sub) IO () -> GHandler sub master RepHtml
-    c <- hamletToContent h
+hamletToRepHtml = fmap RepHtml . hamletToContent
-    return $ RepHtml c
-
--- FIXME some type of JSON combined output...
---hamletToRepHtmlJson :: x
---                    -> (x -> Hamlet (Routes y) IO ())
---                    -> (x -> Json)
---                    -> Handler y RepHtmlJson
 
 instance Monad m => ConvertSuccess String (Hamlet url m ()) where
     convertSuccess = outputHtml . Unencoded . cs

Yesod/Handler.hs

@@ -78,7 +78,7 @@ newtype YesodApp = YesodApp
     :: (ErrorResponse -> YesodApp)
     -> Request
     -> [ContentType]
-    -> IO Response
+    -> IO (W.Status, [Header], ContentType, Content)
     }
 
 ------ Handler monad
@@ -164,28 +164,28 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
             })
         (\e -> return ([], HCError $ toErrorHandler e))
     let handleError e = do
-            Response _ hs ct c <- unYesodApp (eh e) safeEh rr cts
+            (_, hs, ct, c) <- unYesodApp (eh e) safeEh rr cts
             let hs' = headers ++ hs
-            return $ Response (getStatus e) hs' ct c
+            return $ (getStatus e, hs', ct, c)
     let sendFile' ct fp = do
             c <- BL.readFile fp
-            return $ Response W.Status200 headers ct $ cs c
+            return (W.Status200, headers, ct, cs c)
     case contents of
         HCError e -> handleError e
         HCSpecial (Redirect rt loc) -> do
             let hs = Header "Location" loc : headers
-            return $ Response (getRedirectStatus rt) hs TypePlain $ cs ""
+            return (getRedirectStatus rt, hs, TypePlain, cs "")
         HCSpecial (SendFile ct fp) -> Control.Exception.catch
             (sendFile' ct fp)
             (handleError . toErrorHandler)
         HCContent a -> do
             (ct, c) <- chooseRep a cts
-            return $ Response W.Status200 headers ct c
+            return (W.Status200, headers, ct, c)
 
 safeEh :: ErrorResponse -> YesodApp
 safeEh er = YesodApp $ \_ _ _ -> do
     liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
-    return $ Response W.Status500 [] TypePlain $ cs "Internal Server Error"
+    return (W.Status500, [], TypePlain, cs "Internal Server Error")
 
 ------ Special handlers
 specialResponse :: SpecialResponse -> GHandler sub master a
@@ -231,3 +231,15 @@ header a = addHeader . Header a
 
 addHeader :: Header -> GHandler sub master ()
 addHeader h = Handler $ \_ -> return ([h], HCContent ())
+
+getStatus :: ErrorResponse -> W.Status
+getStatus NotFound = W.Status404
+getStatus (InternalError _) = W.Status500
+getStatus (InvalidArgs _) = W.Status400
+getStatus PermissionDenied = W.Status403
+getStatus (BadMethod _) = W.Status405
+
+getRedirectStatus :: RedirectType -> W.Status
+getRedirectStatus RedirectPermanent = W.Status301
+getRedirectStatus RedirectTemporary = W.Status302
+getRedirectStatus RedirectSeeOther = W.Status303

Yesod/Helpers/Auth.hs

@@ -36,12 +36,10 @@ import Yesod
 import Data.Convertible.Text
 
 import Control.Monad.Attempt
-import qualified Data.ByteString.Char8 as B8
 import Data.Maybe
 
 import Data.Typeable (Typeable)
 import Control.Exception (Exception)
-import Control.Applicative ((<$>))
 
 -- FIXME check referer header to determine destination
 
@@ -189,16 +187,16 @@ getLogout = do
     redirectToDest RedirectTemporary $ defaultDest y
 
 -- | Gets the identifier for a user if available.
-maybeIdentifier :: (Functor m, Monad m, RequestReader m) => m (Maybe String)
+maybeIdentifier :: RequestReader m => m (Maybe String)
-maybeIdentifier =
+maybeIdentifier = do
-    fmap cs . lookup (B8.pack authCookieName) . reqSession
+    s <- session
-    <$> getRequest
+    return $ listToMaybe $ s authCookieName
 
 -- | Gets the display name for a user if available.
-displayName :: (Functor m, Monad m, RequestReader m) => m (Maybe String)
+displayName :: RequestReader m => m (Maybe String)
 displayName = do
-    rr <- getRequest
+    s <- session
-    return $ fmap cs $ lookup (B8.pack authDisplayName) $ reqSession rr
+    return $ listToMaybe $ s authDisplayName
 
 -- | Gets the identifier for a user. If user is not logged in, redirects them
 -- to the login page.

Yesod/Request.hs

@@ -1,10 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Request
@@ -15,75 +10,73 @@
 -- Stability     : Stable
 -- Portability   : portable
 --
--- Code for extracting parameters from requests.
+-- | Provides a parsed version of the raw 'W.Request' data.
 --
 ---------------------------------------------------------
 module Yesod.Request
     (
-      -- * Request
+      -- * Request datatype
-      Request (..)
+      RequestBodyContents
+    , Request (..)
     , RequestReader (..)
+      -- * Convenience functions
     , waiRequest
-    , cookies
+    , languages
+      -- * Lookup parameters
     , getParams
     , postParams
-    , languages
+    , cookies
-    , parseWaiRequest
+    , session
-      -- * Parameter
+      -- * Parameter type synonyms
     , ParamName
     , ParamValue
     , ParamError
-#if TEST
-    , testSuite
-#endif
     ) where
 
 import qualified Network.Wai as W
 import Yesod.Definitions
 import Web.Encodings
-import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
-import Data.Convertible.Text
-import Control.Arrow ((***))
-import Data.Maybe (fromMaybe)
 import "transformers" Control.Monad.IO.Class
-import Control.Concurrent.MVar
 import Control.Monad (liftM)
 
-#if TEST
-import Test.Framework (testGroup, Test)
---import Test.Framework.Providers.HUnit
---import Test.HUnit hiding (Test)
-#endif
-
 type ParamName = String
 type ParamValue = String
 type ParamError = String
 
+-- | The reader monad specialized for 'Request'.
 class Monad m => RequestReader m where
     getRequest :: m Request
 instance RequestReader ((->) Request) where
     getRequest = id
 
-languages :: (Functor m, RequestReader m) => m [Language]
+-- | Get the list of supported languages supplied by the user.
-languages = reqLangs `fmap` getRequest
+languages :: RequestReader m => m [Language]
+languages = reqLangs `liftM` getRequest
 
--- | Get the req 'W.Request' value.
+-- | Get the request\'s 'W.Request' value.
 waiRequest :: RequestReader m => m W.Request
 waiRequest = reqWaiRequest `liftM` getRequest
 
+-- | A tuple containing both the POST parameters and submitted files.
 type RequestBodyContents =
     ( [(ParamName, ParamValue)]
     , [(ParamName, FileInfo String BL.ByteString)]
     )
 
--- | The req information passed through W, cleaned up a bit.
+-- | The parsed request information.
 data Request = Request
     { reqGetParams :: [(ParamName, ParamValue)]
     , reqCookies :: [(ParamName, ParamValue)]
-    , reqSession :: [(B.ByteString, B.ByteString)]
+      -- | Session data stored in a cookie via the clientsession package. FIXME explain how to extend.
+    , reqSession :: [(ParamName, ParamValue)]
+      -- | The POST parameters and submitted files. This is stored in an IO
+      -- thunk, which essentially means it will be computed once at most, but
+      -- only if requested. This allows avoidance of the potentially costly
+      -- parsing of POST bodies for pages which do not use them.
     , reqRequestBody :: IO RequestBodyContents
     , reqWaiRequest :: W.Request
+      -- | Languages which the client supports.
     , reqLangs :: [Language]
     }
 
@@ -94,8 +87,10 @@ multiLookup ((k, v):rest) pn
     | otherwise = multiLookup rest pn
 
 -- | All GET paramater values with the given name.
-getParams :: Request -> ParamName -> [ParamValue]
+getParams :: RequestReader m => m (ParamName -> [ParamValue])
-getParams rr = multiLookup $ reqGetParams rr
+getParams = do
+    rr <- getRequest
+    return $ multiLookup $ reqGetParams rr
 
 -- | All POST paramater values with the given name.
 postParams :: MonadIO m => Request -> m (ParamName -> [ParamValue])
@@ -103,52 +98,14 @@ postParams rr = do
     (pp, _) <- liftIO $ reqRequestBody rr
     return $ multiLookup pp
 
--- | Produces a \"compute on demand\" value. The computation will be run once
--- it is requested, and then the result will be stored. This will happen only
--- once.
-iothunk :: IO a -> IO (IO a)
-iothunk = fmap go . newMVar . Left where
-    go :: MVar (Either (IO a) a) -> IO a
-    go mvar = modifyMVar mvar go'
-    go' :: Either (IO a) a -> IO (Either (IO a) a, a)
-    go' (Right val) = return (Right val, val)
-    go' (Left comp) = do
-        val <- comp
-        return (Right val, val)
-
 -- | All cookies with the given name.
-cookies :: Request -> ParamName -> [ParamValue]
+cookies :: RequestReader m => m (ParamName -> [ParamValue])
-cookies rr name =
+cookies = do
-    map snd . filter (fst `equals` name) . reqCookies $ rr
+    rr <- getRequest
-  where
+    return $ multiLookup $ reqCookies rr
-    equals f x y = f y == x
 
-parseWaiRequest :: W.Request
+-- | All session data with the given name.
-                -> [(B.ByteString, B.ByteString)] -- ^ session
+session :: RequestReader m => m (ParamName -> [ParamValue])
-                -> IO Request
+session = do
-parseWaiRequest env session = do
+    rr <- getRequest
-    let gets' = map (cs *** cs) $ decodeUrlPairs $ W.queryString env
+    return $ multiLookup $ reqSession rr
-    let reqCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env
-        cookies' = map (cs *** cs) $ parseCookies reqCookie
-        acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env
-        langs = map cs $ maybe [] parseHttpAccept acceptLang
-        langs' = case lookup langKey cookies' of
-                    Nothing -> langs
-                    Just x -> x : langs
-        langs'' = case lookup langKey gets' of
-                     Nothing -> langs'
-                     Just x -> x : langs'
-    rbthunk <- iothunk $ rbHelper env
-    return $ Request gets' cookies' session rbthunk env langs''
-
-rbHelper :: W.Request -> IO RequestBodyContents
-rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where
-    fix1 = map (cs *** cs)
-    fix2 (x, FileInfo a b c) = (cs x, FileInfo (cs a) (cs b) c)
-
-#if TEST
-testSuite :: Test
-testSuite = testGroup "Yesod.Request"
-    [
-    ]
-#endif

Yesod/Response.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Rank2Types #-}
 ---------------------------------------------------------
 --
@@ -19,42 +18,28 @@
 --
 ---------------------------------------------------------
 module Yesod.Response
-    ( -- * Representations
+    ( -- * Content
       Content (..)
+    , toContent
+      -- * Representations
     , ChooseRep
     , HasReps (..)
     , defChooseRep
-    , ioTextToContent
-      -- ** Convenience wrappers
-    , staticRep
       -- ** Specific content types
     , RepHtml (..)
     , RepJson (..)
     , RepHtmlJson (..)
     , RepPlain (..)
     , RepXml (..)
-      -- * Response type
-    , Response (..)
       -- * Special responses
     , RedirectType (..)
-    , getRedirectStatus
     , SpecialResponse (..)
       -- * Error responses
     , ErrorResponse (..)
-    , getStatus
       -- * Header
     , Header (..)
-    , headerToPair
-      -- * Converting to WAI values
-    , responseToWaiResponse
-#if TEST
-      -- * Tests
-    , testSuite
-    , runContent
-#endif
     ) where
 
-import Data.Time.Clock
 import Data.Maybe (mapMaybe)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
@@ -62,22 +47,19 @@ import Data.Text.Lazy (Text)
 import qualified Data.Text as T
 import Data.Convertible.Text
 
-import Web.Encodings (formatW3)
 import qualified Network.Wai as W
 import qualified Network.Wai.Enumerator as WE
 
-#if TEST
-import Yesod.Request hiding (testSuite)
-import Web.Mime hiding (testSuite)
-#else
 import Yesod.Request
 import Web.Mime
-#endif
-
-#if TEST
-import Test.Framework (testGroup, Test)
-#endif
 
+-- | There are two different methods available for providing content in the
+-- response: via files and enumerators. The former allows server to use
+-- optimizations (usually the sendfile system call) for serving static files.
+-- The latter is a space-efficient approach to content.
+--
+-- It can be tedious to write enumerators; often times, you will be well served
+-- to use 'toContent'.
 data Content = ContentFile FilePath
              | ContentEnum (forall a.
                              (a -> B.ByteString -> IO (Either a a))
@@ -94,13 +76,18 @@ 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
 
-type ChooseRep = [ContentType] -> IO (ContentType, Content)
+-- | A synonym for 'convertSuccess' to make the desired output type explicit.
+toContent :: ConvertSuccess x Content => x -> Content
+toContent = cs
 
--- | It would be nice to simplify 'Content' to the point where this is
+-- | A function which gives targetted representations of content based on the
--- unnecesary.
+-- content-types the user accepts.
-ioTextToContent :: IO Text -> Content
+type ChooseRep =
-ioTextToContent = swapEnum . WE.fromLBS' . fmap cs
+    [ContentType] -- ^ list of content-types user accepts, ordered by preference
+ -> IO (ContentType, Content)
 
 swapEnum :: W.Enumerator -> Content
 swapEnum (W.Enumerator e) = ContentEnum e
@@ -110,13 +97,16 @@ class HasReps a where
     chooseRep :: a -> ChooseRep
 
 -- | A helper method for generating 'HasReps' instances.
+--
+-- This function should be given a list of pairs of content type and conversion
+-- functions. If none of the content types match, the first pair is used.
 defChooseRep :: [(ContentType, a -> IO Content)] -> a -> ChooseRep
 defChooseRep reps a ts = do
   let (ct, c) =
         case mapMaybe helper ts of
             (x:_) -> x
             [] -> case reps of
-                    [] -> error "Empty reps"
+                    [] -> error "Empty reps to defChooseRep"
                     (x:_) -> x
   c' <- c a
   return (ct, c')
@@ -141,13 +131,6 @@ instance HasReps [(ContentType, Content)] where
       where
         go = simpleContentType . contentTypeToString
 
--- | Data with a single representation.
-staticRep :: ConvertSuccess x Content
-          => ContentType
-          -> x
-          -> [(ContentType, Content)]
-staticRep ct x = [(ct, cs x)]
-
 newtype RepHtml = RepHtml Content
 instance HasReps RepHtml where
     chooseRep (RepHtml c) _ = return (TypeHtml, c)
@@ -167,19 +150,12 @@ newtype RepXml = RepXml Content
 instance HasReps RepXml where
     chooseRep (RepXml c) _ = return (TypeXml, c)
 
-data Response = Response W.Status [Header] ContentType Content
-
 -- | Different types of redirects.
 data RedirectType = RedirectPermanent
                   | RedirectTemporary
                   | RedirectSeeOther
     deriving (Show, Eq)
 
-getRedirectStatus :: RedirectType -> W.Status
-getRedirectStatus RedirectPermanent = W.Status301
-getRedirectStatus RedirectTemporary = W.Status302
-getRedirectStatus RedirectSeeOther = W.Status303
-
 -- | Special types of responses which should short-circuit normal response
 -- processing.
 data SpecialResponse =
@@ -197,13 +173,6 @@ data ErrorResponse =
     | BadMethod String
     deriving (Show, Eq)
 
-getStatus :: ErrorResponse -> W.Status
-getStatus NotFound = W.Status404
-getStatus (InternalError _) = W.Status500
-getStatus (InvalidArgs _) = W.Status400
-getStatus PermissionDenied = W.Status403
-getStatus (BadMethod _) = W.Status405
-
 ----- header stuff
 -- | Headers to be added to a 'Result'.
 data Header =
@@ -211,36 +180,3 @@ data Header =
     | DeleteCookie String
     | Header String String
     deriving (Eq, Show)
-
--- | Convert Header to a key/value pair.
-headerToPair :: Header -> IO (W.ResponseHeader, B.ByteString)
-headerToPair (AddCookie minutes key value) = do
-    now <- getCurrentTime
-    let expires = addUTCTime (fromIntegral $ minutes * 60) now
-    return (W.SetCookie, cs $ key ++ "=" ++ value ++"; path=/; expires="
-                              ++ formatW3 expires)
-headerToPair (DeleteCookie key) = return
-    (W.SetCookie, cs $
-     key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
-headerToPair (Header key value) =
-    return (W.responseHeaderFromBS $ cs key, cs value)
-
-responseToWaiResponse :: Response -> IO W.Response
-responseToWaiResponse (Response sc hs ct c) = do
-    hs' <- mapM headerToPair hs
-    let hs'' = (W.ContentType, cs $ contentTypeToString ct) : hs'
-    return $ W.Response sc hs'' $ case c of
-                                    ContentFile fp -> Left fp
-                                    ContentEnum e -> Right $ W.Enumerator e
-
-#if TEST
-runContent :: Content -> IO L.ByteString
-runContent (ContentFile fp) = L.readFile fp
-runContent (ContentEnum c) = WE.toLBS $ W.Enumerator c
-
------ Testing
-testSuite :: Test
-testSuite = testGroup "Yesod.Response"
-    [
-    ]
-#endif