Remove yreRoute

This commit is contained in:
Michael Snoyman 2013-03-13 07:20:20 +02:00
parent 815e185a4b
commit 9a53092be7
5 changed files with 17 additions and 22 deletions

View File

@ -14,11 +14,9 @@ import Yesod.Core.Internal.Request (textQueryString)
class YesodDispatch sub master where
yesodDispatch
:: Yesod master
=> (Maybe (Route sub) -> YesodRunnerEnv sub master)
=> YesodRunnerEnv sub master
-> W.Application
instance YesodDispatch WaiSubsite master where
yesodDispatch getEnv req =
yesodDispatch YesodRunnerEnv { yreSub = WaiSubsite app } req =
app req
where
YesodRunnerEnv { yreSub = WaiSubsite app } = getEnv $ Just $ WaiSubsiteRoute (W.pathInfo req) (textQueryString req)

View File

@ -150,8 +150,8 @@ mkDispatchInstance context sub master res = do
, mdsGetPathInfo = [|W.pathInfo|]
, mdsSetPathInfo = [|\p r -> r { W.pathInfo = p }|]
, mdsMethod = [|W.requestMethod|]
, mds404 = [|\getEnv -> yesodRunner (notFound >> return ()) $ getEnv Nothing|]
, mds405 = [|\getEnv route -> yesodRunner (badMethod >> return ()) (getEnv $ Just route)|]
, mds404 = [|\env -> yesodRunner (notFound >> return ()) env Nothing|]
, mds405 = [|\env route -> yesodRunner (badMethod >> return ()) env (Just route)|]
} res
return $ FunD 'yesodDispatch [clause']
in sequence [instanceD context yDispatch [thisDispatch]]
@ -187,13 +187,12 @@ toWaiApp' y logger sb req =
{ W.pathInfo = pieces
}
where
yre route = YesodRunnerEnv
yre = YesodRunnerEnv
{ yreLogger = logger
, yreMaster = y
, yreSub = y
, yreToMaster = id
, yreSessionBackend = sb
, yreRoute = route
}
sendRedirect :: Yesod master => master -> [Text] -> W.Application

View File

@ -213,8 +213,9 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
yesodRunner :: (ToTypedContent res, Yesod master)
=> GHandler sub master res
-> YesodRunnerEnv sub master
-> Maybe (Route sub)
-> Application
yesodRunner handler' YesodRunnerEnv {..} req
yesodRunner handler' YesodRunnerEnv {..} route req
| KnownLength len <- requestBodyLength req, maxLen < len = return tooLargeResponse
| otherwise = do
let dontSaveSession _ = return []
@ -233,7 +234,7 @@ yesodRunner handler' YesodRunnerEnv {..} req
-- errors out, it will use the safeEh below to recover.
rheSafe = RunHandlerEnv
{ rheRender = yesodRender yreMaster ra
, rheRoute = yreRoute
, rheRoute = route
, rheToMaster = yreToMaster
, rheMaster = yreMaster
, rheSub = yreSub
@ -247,7 +248,7 @@ yesodRunner handler' YesodRunnerEnv {..} req
yar <- runHandler rhe handler yreq
liftIO $ yarToResponse yar saveSession yreq
where
maxLen = maximumContentLength yreMaster $ fmap yreToMaster yreRoute
maxLen = maximumContentLength yreMaster $ fmap yreToMaster route
handler = yesodMiddleware handler'
yesodRender :: Yesod y
@ -275,15 +276,12 @@ resolveApproot master req =
fixEnv :: (oldSub -> newSub)
-> (Route newSub -> Route oldSub)
-> (Maybe (Route oldSub) -> YesodRunnerEnv oldSub master)
-> (Maybe (Route newSub) -> YesodRunnerEnv newSub master)
fixEnv toNewSub toOldRoute getEnvOld newRoute =
go (getEnvOld $ fmap toOldRoute newRoute)
where
go env = env
{ yreSub = toNewSub $ yreSub env
, yreToMaster = yreToMaster env . toOldRoute
, yreRoute = newRoute
-> YesodRunnerEnv oldSub master
-> YesodRunnerEnv newSub master
fixEnv toNewSub toOldRoute envOld =
envOld
{ yreSub = toNewSub $ yreSub envOld
, yreToMaster = yreToMaster envOld . toOldRoute
}
stripHandlerT :: (HandlerReader m, HandlerState m, MonadBaseControl IO m)

View File

@ -187,7 +187,6 @@ data YesodRunnerEnv sub master = YesodRunnerEnv
{ yreLogger :: !Logger
, yreMaster :: !master
, yreSub :: !sub
, yreRoute :: !(Maybe (Route sub))
, yreToMaster :: !(Route sub -> Route master)
, yreSessionBackend :: !(Maybe SessionBackend)
}

View File

@ -303,7 +303,8 @@ buildCaller mds xrest parents name resDisp ys = do
-- Run the whole thing
runner <- [|$(return $ VarE handler)
$(return env)
$(return $ VarE getEnv)
(Just $(return route))
$(return $ VarE req)
|]