New i18n stuff

2011-05-15 17:10:51 +03:00 · 2011-05-15 17:10:51 +03:00 · 13d9932c74
commit 13d9932c74
parent c44ee5509e
5 changed files with 30 additions and 53 deletions
--- a/Yesod/Auth.hs
+++ b/Yesod/Auth.hs
@ -25,7 +25,6 @@ module Yesod.Auth
 import Yesod.Core
 import Yesod.Persist
 import Yesod.Json
-import Text.Blaze
 import Language.Haskell.TH.Syntax hiding (lift)
 import qualified Network.Wai as W
 import Text.Hamlet (hamlet)
@ -39,6 +38,7 @@ import Data.Text.Encoding.Error (lenientDecode)
 import Web.Routes.Quasi (toSinglePiece, fromSinglePiece)
 import Yesod.Auth.Message (AuthMessage, defaultMessage)
 import qualified Yesod.Auth.Message as Msg
+import Yesod.Form (FormMessage)

 data Auth = Auth

@ -61,7 +61,7 @@ data Creds m = Creds
    , credsExtra :: [(Text, Text)]
    }

-class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where
+class (Yesod m, SinglePiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where
    type AuthId m

    -- | Default destination on successful login, if no other
@ -85,11 +85,9 @@ class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where

    renderAuthMessage :: m
                      -> [Text] -- ^ languages
-                      -> AuthMessage -> Html
+                      -> AuthMessage -> Text
    renderAuthMessage _ _ = defaultMessage

-type Texts = [Text]
-
 mkYesodSub "Auth"
    [ ClassP ''YesodAuth [VarT $ mkName "master"]
    ]
@ -114,7 +112,6 @@ setCreds doRedirects creds = do
    y <- getYesod
    maid <- getAuthId creds
    l <- languages
-    let mr = renderMessage Auth y l
    case maid of
        Nothing ->
            if doRedirects
@ -131,14 +128,14 @@ setCreds doRedirects creds = do
 |]
                            sendResponse rh
                        Just ar -> do
-                            setMessage $ mr Msg.InvalidLogin
+                            setMessageI Msg.InvalidLogin
                            redirect RedirectTemporary ar
                else return ()
        Just aid -> do
            setSession credsKey $ toSinglePiece aid
            if doRedirects
                then do
-                    setMessage $ mr Msg.NowLoggedIn
+                    setMessageI Msg.NowLoggedIn
                    redirectUltDest RedirectTemporary $ loginDest y
                else return ()

@ -229,6 +226,5 @@ redirectLogin = do
        Just z -> redirect RedirectTemporary z
        Nothing -> permissionDenied "Please configure authRoute"

-instance YesodAuth m => YesodMessage Auth m where
-    type Message Auth m = AuthMessage
-    renderMessage = const renderAuthMessage
+instance YesodAuth m => RenderMessage m AuthMessage where
+    renderMessage = renderAuthMessage
--- a/Yesod/Auth/Email.hs
+++ b/Yesod/Auth/Email.hs
@ -81,7 +81,6 @@ authEmail =
    AuthPlugin "email" dispatch $ \tm -> do
        y <- lift getYesod
        l <- lift languages
-        let mr = renderMessage (getAuth 'x') y l
 #if GHC7
        [whamlet|
 #else
@ -90,16 +89,16 @@ authEmail =
 <form method="post" action="@{tm loginR}">
    <table>
        <tr>
-            <th>#{mr Msg.Email}
+            <th>_{Msg.Email}
            <td>
                <input type="email" name="email">
        <tr>
-            <th>#{mr Msg.Password}
+            <th>_{Msg.Password}
            <td>
                <input type="password" name="password">
        <tr>
            <td colspan="2">
-                <input type="submit" value=#{mr Msg.LoginViaEmail}>
+                <input type="submit" value=_{Msg.LoginViaEmail}>
                <a href="@{tm registerR}">I don't have an account
 |]
  where
@ -117,9 +116,8 @@ authEmail =
 getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
 getRegisterR = do
    toMaster <- getRouteToMaster
-    mr <- getMessageRender
    defaultLayout $ do
-        setTitle $ mr Msg.RegisterLong
+        setTitleI Msg.RegisterLong
        addWidget
 #if GHC7
            [whamlet|
@ -153,9 +151,8 @@ postRegisterR = do
    tm <- getRouteToMaster
    let verUrl = render $ tm $ verify (toSinglePiece lid) verKey
    sendVerifyEmail email verKey verUrl
-    mr <- getMessageRender
    defaultLayout $ do
-        setTitle $ mr Msg.ConfirmationEmailSentTitle
+        setTitleI Msg.ConfirmationEmailSentTitle
        addWidget
 #if GHC7
            [whamlet|
@ -178,13 +175,11 @@ getVerifyR lid key = do
                Just _uid -> do
                    setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid?
                    toMaster <- getRouteToMaster
-                    mr <- getMessageRender
-                    setMessage $ mr Msg.AddressVerified
+                    setMessageI Msg.AddressVerified
                    redirect RedirectTemporary $ toMaster setpassR
        _ -> return ()
-    mr <- getMessageRender
    defaultLayout $ do
-        setTitle $ mr Msg.InvalidKey
+        setTitleI Msg.InvalidKey
        addWidget
 #if GHC7
            [whamlet|
@ -215,8 +210,7 @@ postLoginR = do
        Just _aid ->
            setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid?
        Nothing -> do
-            mr <- getMessageRender
-            setMessage $ mr Msg.InvalidEmailPass
+            setMessageI Msg.InvalidEmailPass
            toMaster <- getRouteToMaster
            redirect RedirectTemporary $ toMaster LoginR

@ -224,14 +218,13 @@ getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml
 getPasswordR = do
    toMaster <- getRouteToMaster
    maid <- maybeAuthId
-    mr <- getMessageRender
    case maid of
        Just _ -> return ()
        Nothing -> do
-            setMessage $ mr Msg.BadSetPass
+            setMessageI Msg.BadSetPass
            redirect RedirectTemporary $ toMaster loginR
    defaultLayout $ do
-        setTitle $ mr Msg.SetPassTitle
+        setTitleI Msg.SetPassTitle
        addWidget
 #if GHC7
            [whamlet|
@ -262,20 +255,17 @@ postPasswordR = do
    toMaster <- getRouteToMaster
    y <- getYesod
    when (new /= confirm) $ do
-        mr <- getMessageRender
-        setMessage $ mr Msg.PassMismatch
+        setMessageI Msg.PassMismatch
        redirect RedirectTemporary $ toMaster setpassR
    maid <- maybeAuthId
    aid <- case maid of
            Nothing -> do
-                mr <- getMessageRender
-                setMessage $ mr Msg.BadSetPass
+                setMessageI Msg.BadSetPass
                redirect RedirectTemporary $ toMaster loginR
            Just aid -> return aid
    salted <- liftIO $ saltPass new
    setPassword aid salted
-    mr <- getMessageRender
-    setMessage $ mr Msg.PassUpdated
+    setMessageI Msg.PassUpdated
    redirect RedirectTemporary $ loginDest y

 saltLength :: Int
--- a/Yesod/Auth/Facebook.hs
+++ b/Yesod/Auth/Facebook.hs
@ -15,8 +15,6 @@ import Data.Maybe (fromMaybe)
 import Yesod.Form
 import Yesod.Handler
 import Yesod.Widget
-import Yesod.Request (languages)
-import Text.Hamlet (hamlet)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Class (lift)
 import Data.Text (Text)
@ -58,17 +56,13 @@ authFacebook cid secret perms =
        render <- lift getUrlRender
        let fb = Facebook.Facebook cid secret $ render $ tm url
        let furl = Facebook.getForwardUrl fb $ perms
-        y <- lift getYesod
-        l <- lift languages
-        let mr = renderMessage (getAuth 'x') y l
-        addHtml
 #if GHC7
-            [hamlet|
+        [whamlet|
 #else
-            [$hamlet|
+        [$whamlet|
 #endif
 <p>
-    <a href="#{furl}">#{mr Msg.Facebook}
+    <a href="#{furl}">_{Msg.Facebook}
 |]

 parseCreds :: Text -> Value -> Data.Aeson.Types.Parser (Creds m)
--- a/Yesod/Auth/Message.hs
+++ b/Yesod/Auth/Message.hs
@ -34,7 +34,7 @@ data AuthMessage =
    | InvalidLogin
    | NowLoggedIn

-defaultMessage :: AuthMessage -> Html
+defaultMessage :: AuthMessage -> Text
 defaultMessage NoOpenID = "No OpenID identifier found"
 defaultMessage LoginOpenID = "Login via OpenID"
 defaultMessage Email = "Email"
@ -45,7 +45,7 @@ defaultMessage EnterEmail = "Enter your e-mail address below, and a confirmation
 defaultMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent"
 defaultMessage (ConfirmationEmailSent email) =
    "A confirmation e-mail has been sent to " `mappend`
-    toHtml email `mappend`
+    email `mappend`
    "."
 defaultMessage AddressVerified = "Address verified, please set a new password"
 defaultMessage InvalidKeyTitle = "Invalid verification key"
--- a/Yesod/Auth/OpenId.hs
+++ b/Yesod/Auth/OpenId.hs
@ -43,17 +43,15 @@ authOpenId =
    padding-left: 18px;
 |]
        l <- lift languages
-        let mr = renderMessage (getAuth 'x') y l
-        addHamlet
 #if GHC7
-            [hamlet|
+        [whamlet|
 #else
-            [$hamlet|
+        [$whamlet|
 #endif
 <form method="get" action="@{tm forwardUrl}">
-    <label for="#{ident}">OpenID: 
+    <label for="#{ident}">OpenID: #
    <input id="#{ident}" type="text" name="#{name}" value="http://">
-    <input type="submit" value="#{mr Msg.LoginOpenID}">
+    <input type="submit" value="_{Msg.LoginOpenID}">
 |]
    dispatch "GET" ["forward"] = do
        roid <- runInputGet $ iopt textField name
@ -72,8 +70,7 @@ authOpenId =
                  res
            Nothing -> do
                toMaster <- getRouteToMaster
-                mr <- getMessageRender
-                setMessage $ mr Msg.NoOpenID
+                setMessageI Msg.NoOpenID
                redirect RedirectTemporary $ toMaster LoginR
    dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
    dispatch "GET" ["complete"] = do