haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial I18N suport

Browse Source
This commit is contained in:
Michael Snoyman 2011-04-29 17:20:21 +03:00
parent 0d77804d0f
commit ef74164f5f
3 changed files with 75 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Test/Widget.hs
View File

@ -21,6 +21,7 @@ data Y = Y
mkYesod "Y" [$parseRoutes| mkYesod "Y" [$parseRoutes|
/ RootR GET / RootR GET
/foo/*Strings MultiR GET /foo/*Strings MultiR GET
/whamlet WhamletR GET
|] |]
instance Yesod Y where instance Yesod Y where
@ -29,9 +30,26 @@ instance Yesod Y where
getRootR = defaultLayout $ addJuliusBody [$julius|<not escaped>|] getRootR = defaultLayout $ addJuliusBody [$julius|<not escaped>|]
getMultiR _ = return () getMultiR _ = return ()
data Msg = Hello | Goodbye
instance YesodMessage Y where
type Message Y = Msg
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|
<h1>Test
<h2>@{WhamletR}
<h3>_{Goodbye}
|]
widgetTest :: Test widgetTest :: Test
widgetTest = testGroup "Test.Widget" widgetTest = testGroup "Test.Widget"
[ testCase "addJuliusBody" case_addJuliusBody [ testCase "addJuliusBody" case_addJuliusBody
, testCase "whamlet" case_whamlet
] ]
runner f = toWaiApp Y >>= runSession f runner f = toWaiApp Y >>= runSession f
@ -45,3 +63,10 @@ defaultRequest = Request
case_addJuliusBody = runner $ do case_addJuliusBody = runner $ do
res <- request defaultRequest res <- request defaultRequest
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script><not escaped></script></body></html>" res assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script><not escaped></script></body></html>" res
case_whamlet = runner $ do
res <- request defaultRequest
{ pathInfo = ["whamlet"]
, requestHeaders = [("Accept-Language", "es")]
}
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><h1>Test</h1><h2>http://test/whamlet</h2><h3>Adios</h3></body></html>" res

49
Yesod/Widget.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Widgets combine HTML with JS and CSS dependencies with a unique identifier -- | Widgets combine HTML with JS and CSS dependencies with a unique identifier
-- generator, allowing you to create truly modular HTML components. -- generator, allowing you to create truly modular HTML components.
module Yesod.Widget module Yesod.Widget
@ -8,6 +9,11 @@ module Yesod.Widget
GWidget GWidget
, GGWidget (..) , GGWidget (..)
, PageContent (..) , PageContent (..)
-- * Special Hamlet quasiquoter/TH for Widgets
, YesodMessage (..)
, getMessageRender
, whamlet
, whamletFile
-- * Creating -- * Creating
-- ** Head of page -- ** Head of page
, setTitle , setTitle
@ -49,7 +55,7 @@ import Text.Cassius
import Text.Lucius (Lucius) import Text.Lucius (Lucius)
import Text.Julius import Text.Julius
import Yesod.Handler import Yesod.Handler
(Route, GHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod) (Route, GHandler, GGHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod)
import Control.Applicative (Applicative) import Control.Applicative (Applicative)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Class (MonadTrans (lift))
@ -57,8 +63,13 @@ import Yesod.Internal
import Control.Monad (liftM) import Control.Monad (liftM)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Map as Map 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 Control.Monad.IO.Control (MonadControlIO) import Control.Monad.IO.Control (MonadControlIO)
import qualified Text.Hamlet.NonPoly as NP
-- | A generic widget, allowing specification of both the subsite and master -- | A generic widget, allowing specification of both the subsite and master
-- site datatypes. This is basically a large 'WriterT' stack keeping track of -- site datatypes. This is basically a large 'WriterT' stack keeping track of
@ -205,3 +216,39 @@ data PageContent url = PageContent
, pageHead :: Hamlet url , pageHead :: Hamlet url
, pageBody :: Hamlet url , pageBody :: Hamlet url
} }
class YesodMessage a where
type Message a
renderMessage :: a
-> [Text] -- ^ languages
-> Message a
-> Html
getMessageRender :: (Monad mo, YesodMessage s) => GGHandler s m mo (Message s -> Html)
getMessageRender = do
s <- getYesodSub
l <- languages
return $ renderMessage s l
whamlet :: QuasiQuoter
whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
whamletFile :: FilePath -> Q Exp
whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
rules :: Q NP.HamletRules
rules = do
ah <- [|addHtml|]
let helper qg f = do
x <- newName "urender"
e <- f $ VarE x
let e' = LamE [VarP x] e
g <- qg
bind <- [|(>>=)|]
return $ InfixE (Just g) bind (Just e')
let ur f = do
let env = NP.Env
(Just $ helper [|lift getUrlRenderParams|])
(Just $ helper [|lift getMessageRender|])
f env
return $ NP.HamletRules ah ur

4
yesod-core.cabal
View File

@ -1,5 +1,5 @@
name: yesod-core name: yesod-core
version: 0.8.0.1 version: 0.8.1
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -34,7 +34,7 @@ library
, text >= 0.5 && < 0.12 , text >= 0.5 && < 0.12
, template-haskell , template-haskell
, web-routes-quasi >= 0.7.0.1 && < 0.8 , web-routes-quasi >= 0.7.0.1 && < 0.8
, hamlet >= 0.8 && < 0.9 , hamlet >= 0.8.1 && < 0.9
, blaze-builder >= 0.2.1 && < 0.4 , blaze-builder >= 0.2.1 && < 0.4
, transformers >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.3
, clientsession >= 0.6 && < 0.7 , clientsession >= 0.6 && < 0.7