Changed Content data type.

Removed i18n and pushed it back into RawRequest.

Now prepared for the WAI interface, though this is less efficient for
Hack.

Yesod/Request.hs

@@ -28,6 +28,7 @@ module Yesod.Request
     , cookies
     , getParams
     , postParams
+    , languages
       -- * Building actual request
     , Request (..)
     , Hack.RequestMethod (..)
@@ -39,6 +40,7 @@ module Yesod.Request
 import qualified Hack
 import Data.Function.Predicate (equals)
 import Yesod.Parameter
+import Yesod.Definitions
 import Control.Applicative (Applicative (..))
 import Web.Encodings
 import qualified Data.ByteString.Lazy as BL
@@ -99,6 +101,9 @@ getParam = genParam getParams GetParam
 postParam :: (Parameter a) => ParamName -> Request a
 postParam = genParam postParams PostParam
 
+languages :: (Functor m, RequestReader m) => m [Language]
+languages = rawLangs `fmap` getRawRequest
+
 -- | Get the raw 'Hack.Env' value.
 parseEnv :: (Functor m, RequestReader m) => m Hack.Env
 parseEnv = rawEnv `fmap` getRawRequest
@@ -112,6 +117,7 @@ data RawRequest = RawRequest
     , rawPostParams :: [(ParamName, ParamValue)]
     , rawFiles :: [(ParamName, FileInfo String BL.ByteString)]
     , rawEnv :: Hack.Env
+    , rawLangs :: [Language]
     }
     deriving Show
 
@@ -145,7 +151,15 @@ instance ConvertSuccess Hack.Env RawRequest where
                        $ Hack.hackInput env
         rawCookie = fromMaybe "" $ lookup "Cookie" $ Hack.http env
         cookies' = decodeCookies rawCookie :: [(String, String)]
-     in RawRequest gets' cookies' posts files env
+        acceptLang = lookup "Accept-Language" $ Hack.http env
+        langs = 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'
+     in RawRequest gets' cookies' posts files env langs''
 
 #if TEST
 testSuite :: Test

Yesod/Response.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Response
@@ -47,10 +48,12 @@ module Yesod.Response
 
 import Data.Time.Clock
 import Data.Maybe (mapMaybe)
-import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy (ByteString, toChunks, fromChunks)
+import qualified Data.ByteString as B
 import Data.Text.Lazy (Text)
-import Yesod.Definitions
+import qualified Data.Text as T
 import Data.Object.Json
+import Control.Monad (foldM)
 
 import Web.Encodings (formatW3)
 import qualified Hack
@@ -67,14 +70,18 @@ import Test.Framework (testGroup, Test)
 
 import Web.Mime
 
-newtype Content = Content { unContent :: [Language] -> IO ByteString }
+data Content = Content (forall a. ((a -> B.ByteString -> IO a) -> a -> IO a))
 
-instance ConvertSuccess Text Content where
+instance ConvertSuccess B.ByteString Content where
-    convertSuccess = Content . const . return . cs
+    convertSuccess bs = Content $ \f a -> f a bs
 instance ConvertSuccess ByteString Content where
-    convertSuccess = Content . const . return
+    convertSuccess lbs = Content $ \f a -> foldM f a $ toChunks lbs
+instance ConvertSuccess T.Text Content where
+    convertSuccess t = cs (cs t :: B.ByteString)
+instance ConvertSuccess Text Content where
+    convertSuccess lt = cs (cs lt :: ByteString)
 instance ConvertSuccess String Content where
-    convertSuccess = Content . const . return . cs
+    convertSuccess s = cs (cs s :: Text)
 instance ConvertSuccess HtmlDoc Content where
     convertSuccess = cs . unHtmlDoc
 instance ConvertSuccess XmlDoc Content where
@@ -185,14 +192,23 @@ headerToPair (DeleteCookie key) = return
      key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
 headerToPair (Header key value) = return (key, value)
 
-responseToHackResponse :: [String] -- ^ language list
+responseToHackResponse :: Response -> IO Hack.Response
-                       -> Response -> IO Hack.Response
+responseToHackResponse (Response sc hs ct c) = do
-responseToHackResponse ls (Response sc hs ct c) = do
     hs' <- mapM headerToPair hs
     let hs'' = ("Content-Type", cs ct) : hs'
-    asLBS <- unContent c ls
+    asLBS <- runContent c
     return $ Hack.Response sc hs'' asLBS
 
+runContent :: Content -> IO ByteString
+runContent (Content c) = do
+    front <- c helper id
+    return $ fromChunks $ front []
+      where
+        helper :: ([B.ByteString] -> [B.ByteString])
+               -> B.ByteString
+               -> IO ([B.ByteString] -> [B.ByteString])
+        helper front bs = return $ front . (:) bs
+
 #if TEST
 ----- Testing
 testSuite :: Test

Yesod/Yesod.hs

@@ -101,15 +101,7 @@ toHackApp'' y tg env = do
         handler = handlers resource verb
         rr = cs env
     res <- runHandler handler errorHandler rr y tg types
-    let acceptLang = lookup "Accept-Language" $ Hack.http env
+    responseToHackResponse res
-    let langs = maybe [] parseHttpAccept acceptLang
-        langs' = case lookup langKey $ rawCookies rr of
-                    Nothing -> langs
-                    Just x -> x : langs
-        langs'' = case lookup langKey $ rawGetParams rr of
-                     Nothing -> langs'
-                     Just x -> x : langs'
-    responseToHackResponse langs'' res
 
 httpAccept :: Hack.Env -> [ContentType]
 httpAccept = map TypeOther . parseHttpAccept . fromMaybe ""

examples/i18n.hs

@@ -12,23 +12,19 @@ instance Yesod I18N where
     Get: setLang
 |]
 
-homepage = return Hello
+homepage = do
+    ls <- languages
+    let hello = chooseHello ls
+    return [(TypePlain, cs hello :: Content)]
+
+chooseHello [] = "Hello"
+chooseHello ("he":_) = "שלום"
+chooseHello ("es":_) = "Hola"
+chooseHello (_:rest) = chooseHello rest
 
 setLang lang = do
     addCookie 1 langKey lang
     redirect RedirectTemporary "/"
     return ()
 
-data Hello = Hello
-
-instance HasReps Hello where
-    chooseRep = defChooseRep
-            [(TypeHtml, const $ return $ Content $ return . cs . content)]
-      where
-        content [] = "Hello"
-        content ("he":_) = "שלום"
-        content ("es":_) = "Hola"
-        content (_:rest) = content rest
-
-
 main = putStrLn "Running..." >> toHackApp I18N >>= run 3000