Remove yreRoute

yesod-core/Yesod/Core/Class/Dispatch.hs

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

yesod-core/Yesod/Core/Dispatch.hs

@@ -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|]
+                , mds404 = [|\env -> yesodRunner (notFound >> return ()) env Nothing|]
-                , mds405 = [|\getEnv route -> yesodRunner (badMethod >> return ()) (getEnv $ Just route)|]
+                , 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

yesod-core/Yesod/Core/Internal/Run.hs

@@ -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)
+       -> YesodRunnerEnv oldSub master
-       -> (Maybe (Route newSub) -> YesodRunnerEnv newSub master)
+       -> YesodRunnerEnv newSub master
-fixEnv toNewSub toOldRoute getEnvOld newRoute =
+fixEnv toNewSub toOldRoute envOld =
-    go (getEnvOld $ fmap toOldRoute newRoute)
+    envOld
-  where
+        { yreSub = toNewSub $ yreSub envOld
-    go env = env
+        , yreToMaster = yreToMaster envOld . toOldRoute
-        { yreSub = toNewSub $ yreSub env
-        , yreToMaster = yreToMaster env . toOldRoute
-        , yreRoute = newRoute
         }
 
 stripHandlerT :: (HandlerReader m, HandlerState m, MonadBaseControl IO m)

yesod-core/Yesod/Core/Types.hs

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

yesod-routes/Yesod/Routes/TH/Dispatch.hs

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