diff --git a/Yesod/Core.hs b/Yesod/Core.hs index c1c06369..498bfc27 100644 --- a/Yesod/Core.hs +++ b/Yesod/Core.hs @@ -55,6 +55,7 @@ import qualified Data.Map as Map import Data.Time import Network.HTTP.Types (encodePath) import qualified Data.Text as TS +import qualified Data.Text.Encoding as TE import qualified Data.Ascii as A #if GHC7 @@ -64,7 +65,7 @@ import qualified Data.Ascii as A #endif class Eq u => RenderRoute u where - renderRoute :: u -> ([String], [(String, String)]) + renderRoute :: u -> ([String], [(String, String)]) -- FIXME switch to Text? -- | This class is automatically instantiated when you use the template haskell -- mkYesod function. You should never need to deal with it directly. @@ -98,7 +99,7 @@ class RenderRoute (Route a) => Yesod a where -- -- * You do not use any features that require absolute URLs, such as Atom -- feeds and XML sitemaps. - approot :: a -> String + approot :: a -> A.Ascii -- | The encryption key to be used for encrypting client sessions. -- Returning 'Nothing' disables sessions. @@ -135,7 +136,7 @@ class RenderRoute (Route a) => Yesod a where -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid -- sending cookies. - urlRenderOverride :: a -> Route a -> Maybe String + urlRenderOverride :: a -> Route a -> Maybe A.AsciiBuilder urlRenderOverride _ _ = Nothing -- | Determine if a request is authorized or not. @@ -189,16 +190,15 @@ class RenderRoute (Route a) => Yesod a where -- | Join the pieces of a path together into an absolute URL. This should -- be the inverse of 'splitPath'. joinPath :: a - -> String -- ^ application root - -> [String] -- ^ path pieces FIXME Text - -> [(String, String)] -- ^ query string - -> String - joinPath _ ar pieces qs' = - ar ++ A.toString (A.fromAsciiBuilder $ encodePath (map TS.pack pieces) qs) + -> A.AsciiBuilder -- ^ application root + -> [TS.Text] -- ^ path pieces FIXME Text + -> [(TS.Text, TS.Text)] -- ^ query string + -> A.AsciiBuilder + joinPath _ ar pieces qs' = ar `mappend` encodePath pieces qs where - qs = map (charsToBs *** go) qs' + qs = map (TE.encodeUtf8 *** go) qs' go "" = Nothing - go x = Just $ charsToBs x + go x = Just $ TE.encodeUtf8 x -- | This function is used to store some static content to be served as an -- external file. The most common case of this is stashing CSS and @@ -465,8 +465,10 @@ yesodRender :: Yesod y -> [(String, String)] -> String yesodRender y u qs = + A.toString $ A.fromAsciiBuilder $ fromMaybe - (joinPath y (approot y) ps $ qs ++ qs') + ( joinPath y (A.toAsciiBuilder $ approot y) (map TS.pack ps) + $ map (TS.pack *** TS.pack) $ qs ++ qs') (urlRenderOverride y u) where (ps, qs') = renderRoute u diff --git a/Yesod/Internal.hs b/Yesod/Internal.hs index 82205bce..b9a3e64d 100644 --- a/Yesod/Internal.hs +++ b/Yesod/Internal.hs @@ -38,7 +38,6 @@ import Text.Julius (Julius) import Data.Monoid (Monoid (..), Last) import Data.List (nub) -import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L diff --git a/Yesod/Internal/Dispatch.hs b/Yesod/Internal/Dispatch.hs index 2f29c199..2da55d1b 100644 --- a/Yesod/Internal/Dispatch.hs +++ b/Yesod/Internal/Dispatch.hs @@ -17,12 +17,14 @@ import qualified Network.Wai as W import Yesod.Core (yesodRunner, yesodDispatch) import Data.List (foldl') import Data.Char (toLower) -import qualified Data.ByteString.Char8 as S8 -import Data.ByteString.Lazy.Char8 () import qualified Data.ByteString as S import Yesod.Core (Yesod (joinPath, approot, cleanPath)) import Network.HTTP.Types (status301) import qualified Data.Ascii as A +import Data.Text (Text) +import Data.Monoid (mappend) +import qualified Blaze.ByteString.Builder +import qualified Blaze.ByteString.Builder.Char8 {-| @@ -77,18 +79,21 @@ local routes. -} -sendRedirect :: Yesod master => master -> [String] -> W.Application +sendRedirect :: Yesod master => master -> [Text] -> W.Application sendRedirect y segments' env = return $ W.responseLBS status301 [ ("Content-Type", "text/plain") - , ("Location", A.unsafeFromString $ dest') + , ("Location", A.fromAsciiBuilder dest') ] "Redirecting" where - dest = joinPath y (approot y) segments' [] + dest = joinPath y (A.toAsciiBuilder $ approot y) segments' [] dest' = if S.null (W.rawQueryString env) then dest - else dest ++ '?' : S8.unpack (W.rawQueryString env) + else A.unsafeFromBuilder + (A.toBuilder dest `mappend` + Blaze.ByteString.Builder.Char8.fromChar '?' `mappend` + Blaze.ByteString.Builder.fromByteString (W.rawQueryString env)) mkYesodDispatch' :: [((String, Pieces), Maybe String)] -> [((String, Pieces), Maybe String)]