From 32863deb850d20c9a92197de30297776705799cf Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 15 May 2011 15:16:43 +0300 Subject: [PATCH] Much improved i18n support --- Test/Widget.hs | 21 ++++++++++++--------- Yesod/Core.hs | 2 ++ Yesod/Handler.hs | 32 ++++++++++++++++++++++++++++++++ Yesod/Widget.hs | 43 +++++++++++++++++-------------------------- yesod-core.cabal | 3 +++ 5 files changed, 66 insertions(+), 35 deletions(-) diff --git a/Test/Widget.hs b/Test/Widget.hs index 704a1a43..4cd92a5c 100644 --- a/Test/Widget.hs +++ b/Test/Widget.hs @@ -18,6 +18,9 @@ import Network.Wai.Test import qualified Data.ByteString.Lazy.Char8 as L8 data Y = Y + +mkMessage "Y" "test" "en" + mkYesod "Y" [$parseRoutes| / RootR GET /foo/*Strings MultiR GET @@ -31,19 +34,19 @@ getRootR = defaultLayout $ addJuliusBody [$julius||] getMultiR _ = return () data Msg = Hello | Goodbye -instance YesodMessage Y Y where - type Message Y Y = Msg - renderMessage _ _ ("en":_) Hello = "Hello" - renderMessage _ _ ("es":_) Hello = "Hola" - renderMessage _ _ ("en":_) Goodbye = "Goodbye" - renderMessage _ _ ("es":_) Goodbye = "Adios" - renderMessage a b (_:xs) y = renderMessage a b xs y - renderMessage a b [] y = renderMessage a b ["en"] y +instance RenderMessage Y Msg where + renderMessage _ ("en":_) Hello = "Hello" + renderMessage _ ("es":_) Hello = "Hola" + renderMessage _ ("en":_) Goodbye = "Goodbye" + renderMessage _ ("es":_) Goodbye = "Adios" + renderMessage a (_:xs) y = renderMessage a xs y + renderMessage a [] y = renderMessage a ["en"] y getWhamletR = defaultLayout [$whamlet|

Test

@{WhamletR}

_{Goodbye} +

_{MsgAnother} ^{embed} |] where @@ -72,4 +75,4 @@ case_whamlet = runner $ do { pathInfo = ["whamlet"] , requestHeaders = [("Accept-Language", "es")] } - assertBody "\n

Test

http://test/whamlet

Adios

Embed

" res + assertBody "\n

Test

http://test/whamlet

Adios

String

Embed

" res diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 8307bf5e..67ed22e0 100644 --- a/Yesod/Core.hs +++ b/Yesod/Core.hs @@ -31,6 +31,7 @@ module Yesod.Core , module Yesod.Handler , module Yesod.Request , module Yesod.Widget + , module Yesod.Message ) where import Yesod.Internal.Core @@ -39,6 +40,7 @@ import Yesod.Dispatch import Yesod.Handler import Yesod.Request import Yesod.Widget +import Yesod.Message import Language.Haskell.TH.Syntax import Data.Text (Text) diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 42cdd7b5..12ab83a2 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -50,7 +50,9 @@ module Yesod.Handler , notFound , badMethod , permissionDenied + , permissionDeniedI , invalidArgs + , invalidArgsI -- ** Short-circuit responses. , sendFile , sendFilePart @@ -81,6 +83,7 @@ module Yesod.Handler , redirectUltDest -- ** Messages , setMessage + , setMessageI , getMessage -- * Helpers for specific content -- ** Hamlet @@ -89,6 +92,8 @@ module Yesod.Handler -- ** Misc , newIdent , liftIOHandler + -- * i18n + , getMessageRender -- * Internal Yesod , runHandler , YesodApp (..) @@ -154,6 +159,7 @@ import qualified Data.ByteString.Char8 as S8 import Data.CaseInsensitive (CI) import Blaze.ByteString.Builder (toByteString) import Data.Text (Text) +import Yesod.Message (RenderMessage (..)) -- | The type-safe URLs associated with a site argument. type family Route a @@ -501,6 +507,14 @@ msgKey = "_MSG" setMessage :: Monad mo => Html -> GGHandler sub master mo () setMessage = setSession msgKey . T.concat . TL.toChunks . Text.Blaze.Renderer.Text.renderHtml +-- | Sets a message in the user's session. +-- +-- See 'getMessage'. +setMessageI :: (RenderMessage y msg, Monad mo) => msg -> GGHandler sub y mo () +setMessageI msg = do + mr <- getMessageRender + setMessage $ toHtml $ mr msg + -- | Gets the message in the user's session, if available, and then clears the -- variable. -- @@ -569,10 +583,22 @@ badMethod = do permissionDenied :: Failure ErrorResponse m => Text -> m a permissionDenied = failure . PermissionDenied +-- | Return a 403 permission denied page. +permissionDeniedI :: (RenderMessage y msg, Monad mo) => msg -> GGHandler s y mo a +permissionDeniedI msg = do + mr <- getMessageRender + permissionDenied $ mr msg + -- | Return a 400 invalid arguments page. invalidArgs :: Failure ErrorResponse m => [Text] -> m a invalidArgs = failure . InvalidArgs +-- | Return a 400 invalid arguments page. +invalidArgsI :: (RenderMessage y msg, Monad mo) => [msg] -> GGHandler s y mo a +invalidArgsI msg = do + mr <- getMessageRender + invalidArgs $ map mr msg + ------- Headers -- | Set the cookie on the client. setCookie :: Monad mo @@ -848,3 +874,9 @@ hamletToRepHtml = liftM RepHtml . hamletToContent -- | Get the request\'s 'W.Request' value. waiRequest :: Monad mo => GGHandler sub master mo W.Request waiRequest = reqWaiRequest `liftM` getRequest + +getMessageRender :: (Monad mo, RenderMessage master message) => GGHandler s master mo (message -> Text) +getMessageRender = do + m <- getYesod + l <- reqLangs `liftM` getRequest + return $ renderMessage m l diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index 2bc35f8f..7cbfb98c 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -11,14 +11,13 @@ module Yesod.Widget , GGWidget (..) , PageContent (..) -- * Special Hamlet quasiquoter/TH for Widgets - , YesodMessage (..) - , getMessageRender , whamlet , whamletFile , ihamletToRepHtml -- * Creating -- ** Head of page , setTitle + , setTitleI , addHamletHead , addHtmlHead -- ** Body @@ -56,7 +55,10 @@ import Text.Cassius import Text.Lucius (Lucius) import Text.Julius import Yesod.Handler - (Route, GHandler, GGHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod) + (Route, GHandler, GGHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod + , getMessageRender + ) +import Yesod.Message (RenderMessage) import Yesod.Content (RepHtml (..), toContent) import Control.Applicative (Applicative) import Control.Monad.IO.Class (MonadIO) @@ -67,8 +69,7 @@ import Data.Text (Text) import qualified Data.Map as Map import Language.Haskell.TH.Quote (QuasiQuoter) import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE), Pat (VarP), newName) -import Yesod.Handler (getUrlRenderParams, getYesodSub) -import Yesod.Request (languages) +import Yesod.Handler (getUrlRenderParams) import Control.Monad.IO.Control (MonadControlIO) import qualified Text.Hamlet.NonPoly as NP @@ -117,6 +118,13 @@ addSubWidget sub (GWidget w) = do setTitle :: Monad m => Html -> GGWidget master m () setTitle x = GWidget $ tell $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty +-- | Set the page title. Calling 'setTitle' multiple times overrides previously +-- set values. +setTitleI :: (RenderMessage master msg, Monad m) => msg -> GGWidget master (GGHandler sub master m) () +setTitleI msg = do + mr <- lift getMessageRender + setTitle $ toHtml $ mr msg + -- | Add a 'Hamlet' to the head tag. addHamletHead :: Monad m => Hamlet (Route master) -> GGWidget master m () addHamletHead = GWidget . tell . GWData mempty mempty mempty mempty mempty mempty . Head @@ -219,23 +227,6 @@ data PageContent url = PageContent , pageBody :: Hamlet url } --- see if it's possible to get rid of sub here. Problem was yesod-auth, but maybe we can do something like: --- instance YesodAuth m => YesodMessage m ... -class YesodMessage sub master where - type Message sub master - renderMessage :: sub - -> master - -> [Text] -- ^ languages - -> Message sub master - -> Html - -getMessageRender :: (Monad mo, YesodMessage s m) => GGHandler s m mo (Message s m -> Html) -getMessageRender = do - s <- getYesodSub - m <- getYesod - l <- languages - return $ renderMessage s m l - whamlet :: QuasiQuoter whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings @@ -255,15 +246,15 @@ rules = do let ur f = do let env = NP.Env (Just $ helper [|lift getUrlRenderParams|]) - (Just $ helper [|lift getMessageRender|]) + (Just $ helper [|fmap (toHtml .) $ lift getMessageRender|]) f env return $ NP.HamletRules ah ur $ \_ b -> return b -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. -ihamletToRepHtml :: (Monad mo, YesodMessage sub master) - => NP.IHamlet (Message sub master) (Route master) +ihamletToRepHtml :: (Monad mo, RenderMessage master message) + => NP.IHamlet message (Route master) -> GGHandler sub master mo RepHtml ihamletToRepHtml ih = do urender <- getUrlRenderParams mrender <- getMessageRender - return $ RepHtml $ toContent $ ih mrender urender + return $ RepHtml $ toContent $ ih (toHtml . mrender) urender diff --git a/yesod-core.cabal b/yesod-core.cabal index 3c88a41a..02367e98 100644 --- a/yesod-core.cabal +++ b/yesod-core.cabal @@ -49,12 +49,15 @@ library , blaze-html >= 0.4 && < 0.5 , http-types >= 0.6 && < 0.7 , case-insensitive >= 0.2 && < 0.3 + , parsec >= 2 && < 3.2 + , directory >= 1 && < 1.2 exposed-modules: Yesod.Content Yesod.Core Yesod.Dispatch Yesod.Handler Yesod.Request Yesod.Widget + Yesod.Message other-modules: Yesod.Internal Yesod.Internal.Core Yesod.Internal.Session