More cleanups

This commit is contained in:
Michael Snoyman 2013-03-17 12:46:55 +02:00
parent 090191bec3
commit 3b121ccde5
3 changed files with 14 additions and 6 deletions

View File

@ -37,4 +37,4 @@ getHomeR = defaultLayout
main :: IO ()
main = do
app <- App <$> newWiki
warpDebug 3000 app
warp 3000 app

View File

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

View File

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