New i18n stuff

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
+instance YesodAuth m => RenderMessage m AuthMessage where
-    type Message Auth m = AuthMessage
+    renderMessage = renderAuthMessage
-    renderMessage = const renderAuthMessage

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
+                    setMessageI Msg.AddressVerified
-                    setMessage $ mr 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
+            setMessageI Msg.InvalidEmailPass
-            setMessage $ mr 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
+        setMessageI Msg.PassMismatch
-        setMessage $ mr Msg.PassMismatch
         redirect RedirectTemporary $ toMaster setpassR
     maid <- maybeAuthId
     aid <- case maid of
             Nothing -> do
-                mr <- getMessageRender
+                setMessageI Msg.BadSetPass
-                setMessage $ mr Msg.BadSetPass
                 redirect RedirectTemporary $ toMaster loginR
             Just aid -> return aid
     salted <- liftIO $ saltPass new
     setPassword aid salted
-    mr <- getMessageRender
+    setMessageI Msg.PassUpdated
-    setMessage $ mr Msg.PassUpdated
     redirect RedirectTemporary $ loginDest y
 
 saltLength :: Int

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)

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"

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
+                setMessageI Msg.NoOpenID
-                setMessage $ mr Msg.NoOpenID
                 redirect RedirectTemporary $ toMaster LoginR
     dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
     dispatch "GET" ["complete"] = do