Renamed RawRequest to Request

Yesod/Form.hs

@@ -52,14 +52,14 @@ runFormGeneric params (Form f) =
 -- | Run a form against POST parameters.
 runFormPost :: Form x -> Handler y x
 runFormPost f = do
-    rr <- getRawRequest
+    rr <- getRequest
     pp <- postParams rr
     runFormGeneric pp f
 
 -- | Run a form against GET parameters.
 runFormGet :: Form x -> Handler y x
 runFormGet f = do
-    rr <- getRawRequest
+    rr <- getRequest
     runFormGeneric (getParams rr) f
 
 input :: ParamName -> Form [ParamValue]

Yesod/Handler.hs

@@ -51,7 +51,7 @@ import Data.Object.Html
 import qualified Data.ByteString.Lazy as BL
 import qualified Network.Wai as W
 
-data HandlerData yesod = HandlerData RawRequest yesod
+data HandlerData yesod = HandlerData Request yesod
 
 ------ Handler monad
 newtype Handler yesod a = Handler {
@@ -84,7 +84,7 @@ instance MonadIO (Handler yesod) where
 instance Exception e => Failure e (Handler yesod) where
     failure e = Handler $ \_ -> return ([], HCError $ InternalError $ show e)
 instance RequestReader (Handler yesod) where
-    getRawRequest = Handler $ \(HandlerData rr _)
+    getRequest = Handler $ \(HandlerData rr _)
                         -> return ([], HCContent rr)
 
 getYesod :: Handler yesod yesod
@@ -92,7 +92,7 @@ getYesod = Handler $ \(HandlerData _ yesod) -> return ([], HCContent yesod)
 
 runHandler :: Handler yesod ChooseRep
            -> (ErrorResponse -> Handler yesod ChooseRep)
-           -> RawRequest
+           -> Request
            -> yesod
            -> [ContentType]
            -> IO Response

Yesod/Helpers/Auth.hs

@@ -98,7 +98,7 @@ instance Exception ExpectedSingleParam
 
 authOpenidForm :: Yesod y => Handler y ChooseRep
 authOpenidForm = do
-    rr <- getRawRequest
+    rr <- getRequest
     case getParams rr "dest" of
         [] -> return ()
         (x:_) -> addCookie destCookieTimeout destCookieName x
@@ -119,7 +119,7 @@ authOpenidForm = do
 
 authOpenidForward :: YesodAuth y => Handler y ()
 authOpenidForward = do
-    rr <- getRawRequest
+    rr <- getRequest
     oid <- case getParams rr "openid" of
             [x] -> return x
             _ -> invalidArgs [("openid", show ExpectedSingleParam)]
@@ -134,8 +134,8 @@ authOpenidForward = do
 
 authOpenidComplete :: YesodApproot y => Handler y ()
 authOpenidComplete = do
-    rr <- getRawRequest
-    let gets' = rawGetParams rr
+    rr <- getRequest
+    let gets' = reqGetParams rr
     res <- runAttemptT $ OpenId.authenticate gets'
     let onFailure err = redirect RedirectTemporary
                              $ "/auth/openid/?message="
@@ -153,7 +153,7 @@ rpxnowLogin = do
     apiKey <- case rpxnowApiKey ay of
                 Just x -> return x
                 Nothing -> notFound
-    rr <- getRawRequest
+    rr <- getRequest
     pp <- postParams rr
     let token = case getParams rr "token" ++ pp "token" of
                     [] -> failure MissingToken
@@ -201,14 +201,14 @@ authLogout = do
 -- | Gets the identifier for a user if available.
 maybeIdentifier :: (Functor m, Monad m, RequestReader m) => m (Maybe String)
 maybeIdentifier =
-    fmap cs . lookup (B8.pack authCookieName) . rawSession
-    <$> getRawRequest
+    fmap cs . lookup (B8.pack authCookieName) . reqSession
+    <$> getRequest
 
 -- | Gets the display name for a user if available.
 displayName :: (Functor m, Monad m, RequestReader m) => m (Maybe String)
 displayName = do
-    rr <- getRawRequest
-    return $ fmap cs $ lookup (B8.pack authDisplayName) $ rawSession rr
+    rr <- getRequest
+    return $ fmap cs $ lookup (B8.pack authDisplayName) $ reqSession rr
 
 -- | Gets the identifier for a user. If user is not logged in, redirects them
 -- to the login page.
@@ -249,7 +249,7 @@ redirectSetDest rt dest = do
 -- cookie is missing, then use the default path provided.
 redirectToDest :: RedirectType -> String -> Handler y a
 redirectToDest rt def = do
-    rr <- getRawRequest
+    rr <- getRequest
     dest <- case cookies rr destCookieName of
                 [] -> return def
                 (x:_) -> do

Yesod/Request.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Request
@@ -19,8 +20,8 @@
 ---------------------------------------------------------
 module Yesod.Request
     (
-      -- * RawRequest
-      RawRequest (..)
+      -- * Request
+      Request (..)
     , RequestReader (..)
     , waiRequest
     , cookies
@@ -60,30 +61,30 @@ type ParamValue = String
 type ParamError = String
 
 class RequestReader m where
-    getRawRequest :: m RawRequest
-instance RequestReader ((->) RawRequest) where
-    getRawRequest = id
+    getRequest :: m Request
+instance RequestReader ((->) Request) where
+    getRequest = id
 
 languages :: (Functor m, RequestReader m) => m [Language]
-languages = rawLangs `fmap` getRawRequest
+languages = reqLangs `fmap` getRequest
 
--- | Get the raw 'W.Request' value.
+-- | Get the req 'W.Request' value.
 waiRequest :: (Functor m, RequestReader m) => m W.Request
-waiRequest = rawWaiRequest `fmap` getRawRequest
+waiRequest = reqWaiRequest `fmap` getRequest
 
 type RequestBodyContents =
     ( [(ParamName, ParamValue)]
     , [(ParamName, FileInfo String BL.ByteString)]
     )
 
--- | The raw information passed through W, cleaned up a bit.
-data RawRequest = RawRequest
-    { rawGetParams :: [(ParamName, ParamValue)]
-    , rawCookies :: [(ParamName, ParamValue)]
-    , rawSession :: [(B.ByteString, B.ByteString)]
-    , rawRequestBody :: IO RequestBodyContents
-    , rawWaiRequest :: W.Request
-    , rawLangs :: [Language]
+-- | The req information passed through W, cleaned up a bit.
+data Request = Request
+    { reqGetParams :: [(ParamName, ParamValue)]
+    , reqCookies :: [(ParamName, ParamValue)]
+    , reqSession :: [(B.ByteString, B.ByteString)]
+    , reqRequestBody :: IO RequestBodyContents
+    , reqWaiRequest :: W.Request
+    , reqLangs :: [Language]
     }
 
 multiLookup :: [(ParamName, ParamValue)] -> ParamName -> [ParamValue]
@@ -93,13 +94,13 @@ multiLookup ((k, v):rest) pn
     | otherwise = multiLookup rest pn
 
 -- | All GET paramater values with the given name.
-getParams :: RawRequest -> ParamName -> [ParamValue]
-getParams rr = multiLookup $ rawGetParams rr
+getParams :: Request -> ParamName -> [ParamValue]
+getParams rr = multiLookup $ reqGetParams rr
 
 -- | All POST paramater values with the given name.
-postParams :: MonadIO m => RawRequest -> m (ParamName -> [ParamValue])
+postParams :: MonadIO m => Request -> m (ParamName -> [ParamValue])
 postParams rr = do
-    (pp, _) <- liftIO $ rawRequestBody rr
+    (pp, _) <- liftIO $ reqRequestBody rr
     return $ multiLookup pp
 
 -- | Produces a \"compute on demand\" value. The computation will be run once
@@ -116,14 +117,16 @@ iothunk = fmap go . newMVar . Left where
         return (Right val, val)
 
 -- | All cookies with the given name.
-cookies :: RawRequest -> ParamName -> [ParamValue]
-cookies rr name = map snd . filter (fst `equals` name) . rawCookies $ rr
+cookies :: Request -> ParamName -> [ParamValue]
+cookies rr name = map snd . filter (fst `equals` name) . reqCookies $ rr
 
-parseWaiRequest :: W.Request -> [(B.ByteString, B.ByteString)] -> IO RawRequest
+parseWaiRequest :: W.Request
+                -> [(B.ByteString, B.ByteString)] -- ^ session
+                -> IO Request
 parseWaiRequest env session = do
     let gets' = map (cs *** cs) $ decodeUrlPairs $ W.queryString env
-    let rawCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env
-        cookies' = map (cs *** cs) $ parseCookies rawCookie
+    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
@@ -133,7 +136,7 @@ parseWaiRequest env session = do
                      Nothing -> langs'
                      Just x -> x : langs'
     rbthunk <- iothunk $ rbHelper env
-    return $ RawRequest gets' cookies' session rbthunk env langs''
+    return $ Request gets' cookies' session rbthunk env langs''
 
 rbHelper :: W.Request -> IO RequestBodyContents
 rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where

Yesod/Response.hs

@@ -242,7 +242,7 @@ responseToWaiResponse (Response sc hs ct c) = do
 #if TEST
 runContent :: Content -> IO L.ByteString
 runContent (ContentFile fp) = L.readFile fp
-runContent (ContentEnum c) = WE.toLBS c
+runContent (ContentEnum c) = WE.toLBS $ W.Enumerator c
 
 ----- Testing
 testSuite :: Test

Yesod/Template.hs

@@ -22,14 +22,14 @@ import Yesod.Response
 import Yesod.Yesod
 import Yesod.Handler
 import Control.Monad (join)
-import Yesod.Request (RawRequest, getRawRequest)
+import Yesod.Request (Request, getRequest)
 
 type Template = StringTemplate Text
 type TemplateGroup = STGroup Text
 
 class Yesod y => YesodTemplate y where
     getTemplateGroup :: y -> TemplateGroup
-    defaultTemplateAttribs :: y -> RawRequest -> HtmlTemplate
+    defaultTemplateAttribs :: y -> Request -> HtmlTemplate
                            -> IO HtmlTemplate
 
 getTemplateGroup' :: YesodTemplate y => Handler y TemplateGroup
@@ -56,7 +56,7 @@ templateHtml tn f = do
     t <- case getStringTemplate tn tg of
             Nothing -> failure $ NoSuchTemplate tn
             Just x -> return x
-    rr <- getRawRequest
+    rr <- getRequest
     return $ RepHtml $ ioTextToContent
                      $ fmap (render . unHtmlTemplate)
                      $ join
@@ -79,7 +79,7 @@ templateHtmlJson :: YesodTemplate y
 templateHtmlJson tn ho f = do
     tg <- getTemplateGroup'
     y <- getYesod
-    rr <- getRawRequest
+    rr <- getRequest
     t <- case getStringTemplate tn tg of
             Nothing -> failure $ NoSuchTemplate tn
             Just x -> return x

Yesod/Yesod.hs

@@ -46,14 +46,14 @@ class Yesod a where
 
     -- | Applies some form of layout to <title> and <body> contents of a page.
     applyLayout :: a
-                -> RawRequest
+                -> Request
                 -> String -- ^ title
                 -> Html -- ^ body
                 -> Content
     applyLayout _ _ t b = cs (cs (Tag "title" [] $ cs t, b) :: HtmlDoc)
 
     -- | Gets called at the beginning of each request. Useful for logging.
-    onRequest :: a -> RawRequest -> IO ()
+    onRequest :: a -> Request -> IO ()
     onRequest _ _ = return ()
 
 class Yesod a => YesodApproot a where
@@ -67,7 +67,7 @@ applyLayout' :: Yesod y
              -> Handler y ChooseRep
 applyLayout' t b = do
     y <- getYesod
-    rr <- getRawRequest
+    rr <- getRequest
     return $ chooseRep
         [ (TypeHtml, applyLayout y rr t b)
         ]
@@ -80,7 +80,7 @@ applyLayoutJson :: Yesod y
                 -> Handler y ChooseRep
 applyLayoutJson t b = do
     y <- getYesod
-    rr <- getRawRequest
+    rr <- getRequest
     return $ chooseRep
         [ (TypeHtml, applyLayout y rr t $ cs b)
         , (TypeJson, cs $ unJsonDoc $ cs b)

examples/fact.lhs

@@ -89,7 +89,7 @@ one piece of data.
 
 > factRedirect :: Handler y ()
 > factRedirect = do
->     rr <- getRawRequest
+>     rr <- getRequest
 >     let i = case getParams rr "num" of -- FIXME
 >               [] -> "1"
 >               (x:_) -> x

examples/pretty-yaml.hs

@@ -22,8 +22,8 @@ homepageH = templateHtml "pretty-yaml" return
 
 showYamlH :: Handler PY RepHtmlJson
 showYamlH = do
-    rr <- getRawRequest
-    (_, files) <- liftIO $ rawRequestBody rr
+    rr <- getRequest
+    (_, files) <- liftIO $ reqRequestBody rr
     fi <- case lookup "yaml" files of
             Nothing -> invalidArgs [("yaml", "Missing input")]
             Just x -> return x

yesod.cabal

@@ -38,7 +38,7 @@ library
                      authenticate >= 0.4.0 && < 0.5,
                      predicates >= 0.1 && < 0.2,
                      bytestring >= 0.9.1.4 && < 0.10,
-                     web-encodings >= 0.4.0 && < 0.5,
+                     web-encodings >= 0.2.4 && < 0.3,
                      data-object >= 0.2.0 && < 0.3,
                      data-object-yaml >= 0.2.0 && < 0.3,
                      directory >= 1 && < 1.1,
@@ -107,3 +107,19 @@ executable             fact
     Buildable: False
   ghc-options:         -Wall
   main-is:             examples/fact.lhs
+
+executable             i18n
+  if flag(buildsamples)
+    Buildable: True
+  else
+    Buildable: False
+  ghc-options:         -Wall
+  main-is:             examples/i18n.hs
+
+executable             pretty-yaml
+  if flag(buildsamples)
+    Buildable: True
+  else
+    Buildable: False
+  ghc-options:         -Wall
+  main-is:             examples/pretty-yaml.hs