From 2e7e24f2a267398c8b1f091600f57eae925a4735 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 1 Apr 2011 14:24:21 +0300 Subject: [PATCH] addJuliusBody --- Test/Widget.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ Yesod/Widget.hs | 9 ++++++++- runtests.hs | 2 ++ 3 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 Test/Widget.hs diff --git a/Test/Widget.hs b/Test/Widget.hs new file mode 100644 index 00000000..b3edabff --- /dev/null +++ b/Test/Widget.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +module Test.Widget (widgetTest) where + +import Yesod.Core +import Yesod.Content +import Yesod.Dispatch +import Yesod.Widget +import Text.Julius + +import Test.Framework (defaultMain, testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) +import Network.Wai +import Network.Wai.Test + +import qualified Data.ByteString.Lazy.Char8 as L8 + +data Y = Y +mkYesod "Y" [$parseRoutes| +/ RootR GET +|] + +instance Yesod Y where + approot _ = "http://test" + +getRootR = defaultLayout $ addJuliusBody [$julius||] + +widgetTest :: Test +widgetTest = testGroup "Test.Exceptions" + [ testCase "addJuliusBody" case_addJuliusBody + ] + +runner f = toWaiApp Y >>= runSession f +defaultRequest = Request + { pathInfo = [] + , requestHeaders = [] + , queryString = [] + , requestMethod = "GET" + } + +case_addJuliusBody = runner $ do + res <- request defaultRequest + assertBody "\n" res diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index ade2f79a..b32d8665 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -27,6 +27,7 @@ module Yesod.Widget , addStylesheetEither -- ** Javascript , addJulius + , addJuliusBody , addScript , addScriptAttrs , addScriptRemote @@ -38,7 +39,8 @@ module Yesod.Widget import Data.Monoid import Control.Monad.Trans.RWS -import Text.Blaze (preEscapedText) +import Text.Blaze (preEscapedText, preEscapedLazyText) +import qualified Text.Blaze.Html5 as H import Text.Hamlet import Text.Cassius import Text.Julius @@ -164,6 +166,11 @@ addScriptRemoteAttrs x y = GWidget $ tell $ GWData mempty mempty (toUnique $ Scr addJulius :: Monad m => Julius (Route master) -> GGWidget master m () addJulius x = GWidget $ tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty +-- | Add a new script tag to the body with the contents of this 'Julius' +-- template. +addJuliusBody :: Monad m => Julius (Route master) -> GGWidget master m () +addJuliusBody j = addHamlet $ \r -> H.script $ preEscapedLazyText $ renderJulius r j + -- | Pull out the HTML tag contents and return it. Useful for performing some -- manipulations. It can be easier to use this sometimes than 'wrapWidget'. extractBody :: Monad mo => GGWidget m mo () -> GGWidget m mo (Hamlet (Route m)) diff --git a/runtests.hs b/runtests.hs index d4d2c34b..ac283084 100644 --- a/runtests.hs +++ b/runtests.hs @@ -1,9 +1,11 @@ import Test.Framework (defaultMain) import Test.CleanPath import Test.Exceptions +import Test.Widget main :: IO () main = defaultMain [ cleanPathTest , exceptionsTest + , widgetTest ]