From b0634b0d45498f73a522d8e301cedb16386c6ecd Mon Sep 17 00:00:00 2001
From: Ari Fordsham <arifordsham@gmail.com>
Date: Sun, 25 Jun 2023 17:43:13 +0300
Subject: [PATCH] Works with subsite-with-static

---
 yesod-core/src/Yesod/Core/Internal/TH.hs | 31 ++++++++++++++++++------
 yesod-core/yesod-core.cabal              |  2 +-
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/yesod-core/src/Yesod/Core/Internal/TH.hs b/yesod-core/src/Yesod/Core/Internal/TH.hs
index 1bbcbbb1..27756688 100644
--- a/yesod-core/src/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/src/Yesod/Core/Internal/TH.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
 module Yesod.Core.Internal.TH where
 
 import Prelude hiding (exp)
@@ -22,6 +23,7 @@ import Text.ParserCombinators.Parsec.Char (alphaNum, spaces, string, char)
 
 import Yesod.Routes.TH
 import Yesod.Routes.Parse
+import Yesod.Core.Content (ToTypedContent (..))
 import Yesod.Core.Types
 import Yesod.Core.Class.Dispatch
 import Yesod.Core.Internal.Run
@@ -217,14 +219,7 @@ mkYesodSubDispatch res = do
             (mkMDS 
                 return 
                 [|subHelper|] 
-                [|\_ getSub toParent env -> yesodSubDispatch
-                    YesodSubRunnerEnv
-                    { ysreParentRunner = ysreParentRunner env
-                    , ysreGetSub = getSub . ysreGetSub env
-                    , ysreToParentRoute = ysreToParentRoute env . toParent
-                    , ysreParentEnv = ysreParentEnv env
-                    }
-                |]) 
+                [|subTopDispatch|]) 
         res
     inner <- newName "inner"
     let innerFun = FunD inner [clause']
@@ -236,6 +231,26 @@ mkYesodSubDispatch res = do
                     [innerFun]
                 ]
     return $ LetE [fun] (VarE helper)
+    
+subTopDispatch :: 
+    (YesodSubDispatch sub master) =>
+        (forall content. ToTypedContent content =>
+            SubHandlerFor child master content ->
+            YesodSubRunnerEnv child master ->
+            Maybe (Route child) ->
+            W.Application
+        ) ->
+        (mid -> sub) ->
+        (Route sub -> Route mid) ->
+        YesodSubRunnerEnv mid master ->
+        W.Application
+subTopDispatch _ getSub toParent env = yesodSubDispatch
+            (YesodSubRunnerEnv
+            { ysreParentRunner = ysreParentRunner env
+            , ysreGetSub = getSub . ysreGetSub env
+            , ysreToParentRoute = ysreToParentRoute env . toParent
+            , ysreParentEnv = ysreParentEnv env
+            })
 
 instanceD :: Cxt -> Type -> [Dec] -> Dec
 instanceD = InstanceD Nothing
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 4aa6b021..c1deb3c0 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.6.24.2
+version:         1.6.24.3
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>