diff --git a/Test/Widget.hs b/Test/Widget.hs index 8b0fcfbe..17116db8 100644 --- a/Test/Widget.hs +++ b/Test/Widget.hs @@ -21,6 +21,7 @@ data Y = Y mkYesod "Y" [$parseRoutes| / RootR GET /foo/*Strings MultiR GET +/whamlet WhamletR GET |] instance Yesod Y where @@ -29,9 +30,26 @@ instance Yesod Y where getRootR = defaultLayout $ addJuliusBody [$julius||] 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| +

Test +

@{WhamletR} +

_{Goodbye} +|] + widgetTest :: Test widgetTest = testGroup "Test.Widget" [ testCase "addJuliusBody" case_addJuliusBody + , testCase "whamlet" case_whamlet ] runner f = toWaiApp Y >>= runSession f @@ -45,3 +63,10 @@ defaultRequest = Request case_addJuliusBody = runner $ do res <- request defaultRequest assertBody "\n" res + +case_whamlet = runner $ do + res <- request defaultRequest + { pathInfo = ["whamlet"] + , requestHeaders = [("Accept-Language", "es")] + } + assertBody "\n

Test

http://test/whamlet

Adios

" res diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index 231e075c..a7fd6c86 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TemplateHaskell #-} -- | Widgets combine HTML with JS and CSS dependencies with a unique identifier -- generator, allowing you to create truly modular HTML components. module Yesod.Widget @@ -8,6 +9,11 @@ module Yesod.Widget GWidget , GGWidget (..) , PageContent (..) + -- * Special Hamlet quasiquoter/TH for Widgets + , YesodMessage (..) + , getMessageRender + , whamlet + , whamletFile -- * Creating -- ** Head of page , setTitle @@ -49,7 +55,7 @@ import Text.Cassius import Text.Lucius (Lucius) import Text.Julius import Yesod.Handler - (Route, GHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod) + (Route, GHandler, GGHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod) import Control.Applicative (Applicative) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (MonadTrans (lift)) @@ -57,8 +63,13 @@ import Yesod.Internal import Control.Monad (liftM) 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 Control.Monad.IO.Control (MonadControlIO) +import qualified Text.Hamlet.NonPoly as NP -- | A generic widget, allowing specification of both the subsite and master -- site datatypes. This is basically a large 'WriterT' stack keeping track of @@ -205,3 +216,39 @@ data PageContent url = PageContent , pageHead :: 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 diff --git a/yesod-core.cabal b/yesod-core.cabal index dd1ace89..f4b1b1bb 100644 --- a/yesod-core.cabal +++ b/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 0.8.0.1 +version: 0.8.1 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -34,7 +34,7 @@ library , text >= 0.5 && < 0.12 , template-haskell , 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 , transformers >= 0.2 && < 0.3 , clientsession >= 0.6 && < 0.7