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

Automatically apply toWidget to ^{} interpolations

Browse Source
This commit is contained in:
Michael Snoyman 2012-04-03 08:07:57 +03:00
parent fc29c153ed
commit 742ffa4d14
2 changed files with 20 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
yesod-core/Yesod/Widget.hs
View File

@ -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

17
yesod-core/test/YesodCoreTest/Widget.hs
View File

@ -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|<h4>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 "<!DOCTYPE html>\n<html><head><title></title></head><body><h1>Test</h1><h2>http://test/whamlet</h2><h3>Adios</h3><h3>String</h3><h4>Embed</h4></body></html>" res
case_auto :: IO ()
case_auto = runner $ do
res <- request defaultRequest
{ pathInfo = ["auto"]
, requestHeaders = [("Accept-Language", "es")]
}
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body>somehtml</body></html>" res