diff --git a/demo/Main.hs b/demo/Main.hs index ae5d6c9f..387b259c 100644 --- a/demo/Main.hs +++ b/demo/Main.hs @@ -37,4 +37,4 @@ getHomeR = defaultLayout main :: IO () main = do app <- App <$> newWiki - warpDebug 3000 app + warp 3000 app diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index f620ed32..e660814d 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -51,6 +51,7 @@ module Yesod.Core , MonadHandler (..) , MonadWidget (..) , getRouteToParent + , defaultLayoutSub -- * Misc , yesodVersion , yesodRender @@ -63,6 +64,7 @@ module Yesod.Core , module Yesod.Core.Json , module Text.Shakespeare.I18N , module Yesod.Core.Internal.Util + , module Text.Blaze.Html , MonadTrans (..) , MonadIO (..) , MonadBase (..) @@ -78,6 +80,7 @@ import Yesod.Core.Json import Yesod.Core.Types import Text.Shakespeare.I18N import Yesod.Core.Internal.Util (formatW3 , formatRFC1123 , formatRFC822) +import Text.Blaze.Html (Html) import Control.Monad.Logger import Control.Monad.Trans.Class (MonadTrans (..)) @@ -116,3 +119,8 @@ maybeAuthorized r isWrite = do getRouteToParent :: Monad m => HandlerT child (HandlerT parent m) (Route child -> Route parent) getRouteToParent = HandlerT $ return . handlerToParent + +defaultLayoutSub :: Yesod parent + => WidgetT child IO () + -> HandlerT child (HandlerT parent IO) Html +defaultLayoutSub cwidget = widgetToParentWidget cwidget >>= lift . defaultLayout diff --git a/yesod-core/Yesod/Core/Widget.hs b/yesod-core/Yesod/Core/Widget.hs index 796ccd43..7aa43d84 100644 --- a/yesod-core/Yesod/Core/Widget.hs +++ b/yesod-core/Yesod/Core/Widget.hs @@ -42,7 +42,7 @@ module Yesod.Core.Widget , addScriptRemoteAttrs , addScriptEither -- * Subsites - , liftWidget + , widgetToParentWidget , handlerToWidget -- * Internal , whamletFileWithSettings @@ -234,10 +234,10 @@ toUnique = UniqueList . (:) handlerToWidget :: Monad m => HandlerT site m a -> WidgetT site m a handlerToWidget (HandlerT f) = WidgetT $ liftM (, mempty) . f -liftWidget :: MonadIO m - => WidgetT child IO a - -> HandlerT child (HandlerT parent m) (WidgetT parent m a) -liftWidget (WidgetT f) = HandlerT $ \hd -> do +widgetToParentWidget :: MonadIO m + => WidgetT child IO a + -> HandlerT child (HandlerT parent m) (WidgetT parent m a) +widgetToParentWidget (WidgetT f) = HandlerT $ \hd -> do (a, gwd) <- liftIO $ f hd { handlerToParent = const () } return $ WidgetT $ const $ return (a, liftGWD (handlerToParent hd) gwd)