More cleanups
This commit is contained in:
parent
090191bec3
commit
3b121ccde5
@ -37,4 +37,4 @@ getHomeR = defaultLayout
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- App <$> newWiki
|
||||
warpDebug 3000 app
|
||||
warp 3000 app
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user