diff --git a/yesod-core/Yesod/Widget.hs b/yesod-core/Yesod/Widget.hs index 220d02d8..0f963767 100644 --- a/yesod-core/Yesod/Widget.hs +++ b/yesod-core/Yesod/Widget.hs @@ -74,7 +74,7 @@ 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 Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE, AppE), Pat (VarP), newName) import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Exception (throwIO) @@ -119,7 +119,7 @@ instance render ~ RY master => ToWidget sub master (render -> Css) where toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ \r -> fromLazyText $ renderCss $ x r) mempty mempty instance render ~ RY master => ToWidget sub master (render -> Javascript) where toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty -instance ToWidget sub master (GWidget sub master ()) where +instance (sub' ~ sub, master' ~ master) => ToWidget sub' master' (GWidget sub master ()) where toWidget = id instance ToWidget sub master Html where toWidget = toWidget . const @@ -277,7 +277,7 @@ rules = do (Just $ helper [|liftW getUrlRenderParams|]) (Just $ helper [|liftM (toHtml .) $ liftW getMessageRender|]) f env - return $ NP.HamletRules ah ur $ \_ b -> return b + return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. ihamletToRepHtml :: RenderMessage master message diff --git a/yesod-core/test/YesodCoreTest/Widget.hs b/yesod-core/test/YesodCoreTest/Widget.hs index f102136e..58aa13ba 100644 --- a/yesod-core/test/YesodCoreTest/Widget.hs +++ b/yesod-core/test/YesodCoreTest/Widget.hs @@ -25,6 +25,7 @@ mkYesod "Y" [parseRoutes| /foo/*Strings MultiR GET /whamlet WhamletR GET /towidget TowidgetR GET +/auto AutoR GET |] instance Yesod Y where @@ -69,11 +70,19 @@ getWhamletR = defaultLayout [whamlet| where embed = [whamlet|

Embed|] +getAutoR :: Handler RepHtml +getAutoR = defaultLayout [whamlet| +^{someHtml} +|] + where + someHtml = [shamlet|somehtml|] + widgetTest :: [Spec] widgetTest = describe "Test.Widget" [ it "addJuliusBody" case_addJuliusBody , it "whamlet" case_whamlet , it "two letter lang codes" case_two_letter_lang + , it "automatically applies toWidget" case_auto ] runner :: Session () -> IO () @@ -99,3 +108,11 @@ case_two_letter_lang = runner $ do , requestHeaders = [("Accept-Language", "es-ES")] } assertBody "\n

Test

http://test/whamlet

Adios

String

Embed

" res + +case_auto :: IO () +case_auto = runner $ do + res <- request defaultRequest + { pathInfo = ["auto"] + , requestHeaders = [("Accept-Language", "es")] + } + assertBody "\nsomehtml" res