Finally removed RequestReader

Yesod/Handler.hs

@@ -35,6 +35,9 @@ module Yesod.Handler
     , getUrlRenderParams
     , getCurrentRoute
     , getRouteToMaster
+    , getRequest
+    , waiRequest
+    , runRequestBody
       -- * Special responses
       -- ** Redirecting
     , RedirectType (..)
@@ -103,7 +106,7 @@ module Yesod.Handler
     ) where
 
 import Prelude hiding (catch)
-import Yesod.Request
+import Yesod.Internal.Request
 import Yesod.Internal
 import Data.Time (UTCTime)
 
@@ -289,19 +292,22 @@ data HandlerContents =
 instance Error HandlerContents where
     strMsg = HCError . InternalError . T.pack
 
+getRequest :: Monad mo => GGHandler s m mo Request
+getRequest = handlerRequest `liftM` GHandler ask
+
 instance Monad monad => Failure ErrorResponse (GGHandler sub master monad) where
     failure = GHandler . lift . throwError . HCError
-instance RequestReader (GHandler sub master) where -- FIXME kill this typeclass, does not work for GGHandler
-    getRequest = handlerRequest <$> GHandler ask
-    runRequestBody = do
-        x <- GHandler $ lift $ lift $ lift get
-        case ghsRBC x of
-            Just rbc -> return rbc
-            Nothing -> do
-                rr <- waiRequest
-                rbc <- lift $ rbHelper rr
-                GHandler $ lift $ lift $ lift $ put x { ghsRBC = Just rbc }
-                return rbc
+
+runRequestBody :: GHandler s m RequestBodyContents
+runRequestBody = do
+    x <- GHandler $ lift $ lift $ lift get
+    case ghsRBC x of
+        Just rbc -> return rbc
+        Nothing -> do
+            rr <- waiRequest
+            rbc <- lift $ rbHelper rr
+            GHandler $ lift $ lift $ lift $ put x { ghsRBC = Just rbc }
+            return rbc
 
 rbHelper :: W.Request -> Iteratee ByteString IO RequestBodyContents
 rbHelper req =
@@ -555,7 +561,7 @@ notFound :: Failure ErrorResponse m => m a
 notFound = failure NotFound
 
 -- | Return a 405 method not supported page.
-badMethod :: (RequestReader m, Failure ErrorResponse m) => m a
+badMethod :: Monad mo => GGHandler s m mo a
 badMethod = do
     w <- waiRequest
     failure $ BadMethod $ W.requestMethod w
@@ -807,3 +813,7 @@ hamletToContent h = do
 hamletToRepHtml :: Monad mo
                 => Hamlet (Route master) -> GGHandler sub master mo RepHtml
 hamletToRepHtml = liftM RepHtml . hamletToContent
+
+-- | Get the request\'s 'W.Request' value.
+waiRequest :: Monad mo => GGHandler sub master mo W.Request
+waiRequest = reqWaiRequest `liftM` getRequest

Yesod/Internal/Request.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Yesod.Internal.Request
     ( parseWaiRequest
+    , Request (..)
+    , RequestBodyContents
+    , FileInfo (..)
     ) where
 
-import Yesod.Request
 import Control.Arrow (first, second)
 import qualified Network.Wai.Parse as NWP
 import Yesod.Internal
@@ -16,6 +18,18 @@ import Data.Text (Text, pack)
 import Network.HTTP.Types (queryToQueryText)
 import Control.Monad (join)
 import Data.Maybe (fromMaybe)
+import qualified Data.ByteString.Lazy as L
+
+-- | The parsed request information.
+data Request = Request
+    { reqGetParams :: [(Text, Text)]
+    , reqCookies :: [(Text, Text)]
+    , reqWaiRequest :: W.Request
+      -- | Languages which the client supports.
+    , reqLangs :: [Text]
+      -- | A random, session-specific nonce used to prevent CSRF attacks.
+    , reqNonce :: Maybe Text
+    }
 
 parseWaiRequest :: W.Request
                 -> [(Text, Text)] -- ^ session
@@ -57,3 +71,16 @@ parseWaiRequest env session' key' = do
         | i < 26 = toEnum $ i + fromEnum 'A'
         | i < 52 = toEnum $ i + fromEnum 'a' - 26
         | otherwise = toEnum $ i + fromEnum '0' - 52
+
+-- | A tuple containing both the POST parameters and submitted files.
+type RequestBodyContents =
+    ( [(Text, Text)]
+    , [(Text, FileInfo)]
+    )
+
+data FileInfo = FileInfo
+    { fileName :: Text
+    , fileContentType :: Text
+    , fileContent :: L.ByteString
+    }
+    deriving (Eq, Show)

Yesod/Request.hs

@@ -16,10 +16,8 @@ module Yesod.Request
       -- * Request datatype
       RequestBodyContents
     , Request (..)
-    , RequestReader (..)
     , FileInfo (..)
       -- * Convenience functions
-    , waiRequest
     , languages
       -- * Lookup parameters
     , lookupGetParam
@@ -33,21 +31,13 @@ module Yesod.Request
     , lookupFiles
     ) where
 
-import qualified Network.Wai as W
-import qualified Data.ByteString.Lazy as BL
-import Control.Monad.IO.Class
+import Yesod.Internal.Request
+import Yesod.Handler
 import Control.Monad (liftM)
 import Control.Monad.Instances () -- I'm missing the instance Monad ((->) r
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 
--- FIXME perhaps remove RequestReader typeclass, include Request datatype in Handler
-
--- | The reader monad specialized for 'Request'.
-class Monad m => RequestReader m where
-    getRequest :: m Request
-    runRequestBody :: m RequestBodyContents
-
 -- | Get the list of supported languages supplied by the user.
 --
 -- Languages are determined based on the following three (in descending order
@@ -62,83 +52,50 @@ class Monad m => RequestReader m where
 -- * Accept-Language HTTP header.
 --
 -- This is handled by parseWaiRequest (not exposed).
-languages :: RequestReader m => m [Text]
+languages :: Monad mo => GGHandler s m mo [Text]
 languages = reqLangs `liftM` getRequest
 
--- | 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 =
-    ( [(Text, Text)]
-    , [(Text, FileInfo)]
-    )
-
-data FileInfo = FileInfo
-    { fileName :: Text
-    , fileContentType :: Text
-    , fileContent :: BL.ByteString
-    }
-    deriving (Eq, Show)
-
--- | The parsed request information.
-data Request = Request
-    { reqGetParams :: [(Text, Text)]
-    , reqCookies :: [(Text, Text)]
-    , reqWaiRequest :: W.Request
-      -- | Languages which the client supports.
-    , reqLangs :: [Text]
-      -- | A random, session-specific nonce used to prevent CSRF attacks.
-    , reqNonce :: Maybe Text
-    }
-
 lookup' :: Eq a => a -> [(a, b)] -> [b]
 lookup' a = map snd . filter (\x -> a == fst x)
 
 -- | Lookup for GET parameters.
-lookupGetParams :: RequestReader m => Text -> m [Text]
+lookupGetParams :: Monad mo => Text -> GGHandler s m mo [Text]
 lookupGetParams pn = do
     rr <- getRequest
     return $ lookup' pn $ reqGetParams rr
 
 -- | Lookup for GET parameters.
-lookupGetParam :: RequestReader m => Text -> m (Maybe Text)
+lookupGetParam :: Monad mo => Text -> GGHandler s m mo (Maybe Text)
 lookupGetParam = liftM listToMaybe . lookupGetParams
 
 -- | Lookup for POST parameters.
-lookupPostParams :: RequestReader m
-                 => Text
-                 -> m [Text]
+lookupPostParams :: Text -> GHandler s m [Text]
 lookupPostParams pn = do
     (pp, _) <- runRequestBody
     return $ lookup' pn pp
 
-lookupPostParam :: (MonadIO m, RequestReader m)
-                => Text
-                -> m (Maybe Text)
+lookupPostParam :: Text
+                -> GHandler s m (Maybe Text)
 lookupPostParam = liftM listToMaybe . lookupPostParams
 
 -- | Lookup for POSTed files.
-lookupFile :: (MonadIO m, RequestReader m)
-           => Text
-           -> m (Maybe FileInfo)
+lookupFile :: Text
+           -> GHandler s m (Maybe FileInfo)
 lookupFile = liftM listToMaybe . lookupFiles
 
 -- | Lookup for POSTed files.
-lookupFiles :: RequestReader m
-            => Text
-            -> m [FileInfo]
+lookupFiles :: Text
+            -> GHandler s m [FileInfo]
 lookupFiles pn = do
     (_, files) <- runRequestBody
     return $ lookup' pn files
 
 -- | Lookup for cookie data.
-lookupCookie :: RequestReader m => Text -> m (Maybe Text)
+lookupCookie :: Monad mo => Text -> GGHandler s m mo (Maybe Text)
 lookupCookie = liftM listToMaybe . lookupCookies
 
 -- | Lookup for cookie data.
-lookupCookies :: RequestReader m => Text -> m [Text]
+lookupCookies :: Monad mo => Text -> GGHandler s m mo [Text]
 lookupCookies pn = do
     rr <- getRequest
     return $ lookup' pn $ reqCookies rr