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

remove runSubHandler, using modified version of toMasterHandler instead

Browse Source
This commit is contained in:
Matt Brown 2010-11-15 15:58:29 -08:00 committed by Michael Snoyman
parent 5e4c0d0170
commit 99fed5a53c
2 changed files with 46 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
Yesod/Handler.hs
View File

@ -48,8 +48,6 @@ module Yesod.Handler
-- ** Short-circuit responses.
, sendFile
, sendResponse
-- ** Calling foreign subsite handlers
, runSubHandler
-- * Setting headers
, setCookie
, deleteCookie
@ -78,6 +76,7 @@ module Yesod.Handler
, runHandler
, YesodApp (..)
, toMasterHandler
, toMasterHandlerMaybe
, localNoCurrent
, HandlerData
, ErrorResponse (..)
@ -142,10 +141,17 @@ handlerSubData :: (Route sub -> Route master)
-> Route sub
-> HandlerData oldSub master
-> HandlerData sub master
handlerSubData tm ts route hd = hd
handlerSubData tm ts = handlerSubDataMaybe tm ts . Just
handlerSubDataMaybe :: (Route sub -> Route master)
-> (master -> sub)
-> Maybe (Route sub)
-> HandlerData oldSub master
-> HandlerData sub master
handlerSubDataMaybe tm ts route hd = hd
{ handlerSub = ts $ handlerMaster hd
, handlerToMaster = tm
, handlerRoute = Just route
, handlerRoute = route
}
-- | Used internally for promoting subsite handler functions to master site
@ -154,10 +160,18 @@ toMasterHandler :: (Route sub -> Route master)
-> (master -> sub)
-> Route sub
-> GHandler sub master a
-> GHandler master master a
-> GHandler sub' master a
toMasterHandler tm ts route (GHandler h) =
GHandler $ withReaderT (handlerSubData tm ts route) h
toMasterHandlerMaybe :: (Route sub -> Route master)
-> (master -> sub)
-> Maybe (Route sub)
-> GHandler sub master a
-> GHandler sub' master a
toMasterHandlerMaybe tm ts route (GHandler h) =
GHandler $ withReaderT (handlerSubDataMaybe tm ts route) h
-- | A generic handler monad, which can have a different subsite and master
-- site. This monad is a combination of 'ReaderT' for basic arguments, a
-- 'WriterT' for headers and session, and an 'MEitherT' monad for handling
@ -217,28 +231,6 @@ instance RequestReader (GHandler sub master) where
getYesodSub :: GHandler sub master sub
getYesodSub = handlerSub <$> GHandler ask
-- | Set the subsite in HandlerData
setHandlerSub :: YesodSubRoute sub' master => sub' -> HandlerData sub master -> HandlerData sub' master
setHandlerSub s (HandlerData r _ m _ rn _) = HandlerData r s m Nothing rn $ fromSubRoute s m
-- | Run a handler from another subsite
runSubHandler :: YesodSubRoute sub' master => sub' -> GHandler sub' master a -> GHandler sub master a
runSubHandler sub handler = do
hd <- setHandlerSub sub <$> GHandler ask
session <- getSession
GHandler $ do
let toErrorHandler =
InternalError
. (show :: Control.Exception.SomeException -> String)
((contents, headers), finalSession) <- liftIO $ flip runStateT session
$ runWriterT
$ runMEitherT
$ flip runReaderT hd
$ unGHandler handler
lift $ lift $ lift $ put finalSession
lift $ MEitherT $ return contents
-- | Get the master site appliation argument.
getYesod :: GHandler sub master master
getYesod = handlerMaster <$> GHandler ask

54
Yesod/Widget.hs
View File

@ -40,7 +40,7 @@ import Control.Monad.Trans.State
import Text.Hamlet
import Text.Cassius
import Text.Julius
import Yesod.Handler (Route, GHandler, HandlerData, YesodSubRoute, runSubHandler)
import Yesod.Handler (Route, GHandler, HandlerData, YesodSubRoute(..), toMasterHandlerMaybe, getYesod)
import Control.Applicative (Applicative)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (lift)
@ -98,32 +98,32 @@ liftHandler :: GHandler sub master a -> GWidget sub master a
liftHandler = GWidget . lift . lift . lift . lift . lift . lift . lift . lift
addSubWidget :: (YesodSubRoute sub master) => sub -> GWidget sub master a -> GWidget sub' master a
addSubWidget sub w = do
i <- GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift get
w' <- liftHandler $ runSubHandler sub $ flip runStateT i
$ runWriterT $ runWriterT $ runWriterT $ runWriterT
$ runWriterT $ runWriterT $ runWriterT
$ unGWidget w
let ((((((((a,
body),
title),
scripts),
stylesheets),
style),
jscript),
h),
i') = w'
GWidget $ do
tell body
lift $ tell title
lift $ lift $ tell scripts
lift $ lift $ lift $ tell stylesheets
lift $ lift $ lift $ lift $ tell style
lift $ lift $ lift $ lift $ lift $ tell jscript
lift $ lift $ lift $ lift $ lift $ lift $ tell h
lift $ lift $ lift $ lift $ lift $ lift $ lift $ put i'
return a
addSubWidget sub w = do master <- liftHandler getYesod
let sr = fromSubRoute sub master
i <- GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift get
w' <- liftHandler $ toMasterHandlerMaybe sr (const sub) Nothing $ flip runStateT i
$ runWriterT $ runWriterT $ runWriterT $ runWriterT
$ runWriterT $ runWriterT $ runWriterT
$ unGWidget w
let ((((((((a,
body),
title),
scripts),
stylesheets),
style),
jscript),
h),
i') = w'
GWidget $ do
tell body
lift $ tell title
lift $ lift $ tell scripts
lift $ lift $ lift $ tell stylesheets
lift $ lift $ lift $ lift $ tell style
lift $ lift $ lift $ lift $ lift $ tell jscript
lift $ lift $ lift $ lift $ lift $ lift $ tell h
lift $ lift $ lift $ lift $ lift $ lift $ lift $ put i'
return a
-- | Set the page title. Calling 'setTitle' multiple times overrides previously
-- set values.