From 9859fe1ddbdb0e50ab195426795efc17142bb796 Mon Sep 17 00:00:00 2001
From: Anupam Jain <ajnsit@gmail.com>
Date: Wed, 13 Jan 2016 11:00:09 +0530
Subject: [PATCH 1/2] Pass hierarchical route arguments to subsites

---
 yesod-core/Yesod/Routes/TH/Dispatch.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/yesod-core/Yesod/Routes/TH/Dispatch.hs b/yesod-core/Yesod/Routes/TH/Dispatch.hs
index 5d3596ec..c061a1c2 100644
--- a/yesod-core/Yesod/Routes/TH/Dispatch.hs
+++ b/yesod-core/Yesod/Routes/TH/Dispatch.hs
@@ -176,9 +176,10 @@ mkDispatchClause MkDispatchSettings {..} resources = do
                     subDispatcherE <- mdsSubDispatcher
                     runHandlerE <- mdsRunHandler
                     sub <- newName "sub"
+                    let allDyns = extraParams ++ dyns
                     sroute <- newName "sroute"
                     let sub2 = LamE [VarP sub]
-                            (foldl' (\a b -> a `AppE` b) (VarE (mkName getSub) `AppE` VarE sub) dyns)
+                            (foldl' (\a b -> a `AppE` b) (VarE (mkName getSub) `AppE` VarE sub) allDyns)
                     let reqExp' = setPathInfoE `AppE` VarE restPath `AppE` reqExp
                         route' = foldl' AppE (ConE (mkName name)) dyns
                         route = LamE [VarP sroute] $ foldr AppE (AppE route' $ VarE sroute) extraCons

From 38680c6568852b5258c026827df4335a5c6fd342 Mon Sep 17 00:00:00 2001
From: Anupam Jain <ajnsit@gmail.com>
Date: Tue, 19 Jan 2016 17:06:40 +0530
Subject: [PATCH 2/2] Add test for hierarchical subsite with arguments

Note: Needed to enable ViewPatterns for this
---
 yesod-core/test/YesodCoreTest/WaiSubsite.hs | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

diff --git a/yesod-core/test/YesodCoreTest/WaiSubsite.hs b/yesod-core/test/YesodCoreTest/WaiSubsite.hs
index 6b55601f..aae07e80 100644
--- a/yesod-core/test/YesodCoreTest/WaiSubsite.hs
+++ b/yesod-core/test/YesodCoreTest/WaiSubsite.hs
@@ -1,15 +1,21 @@
-{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
+{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, ViewPatterns #-}
 module YesodCoreTest.WaiSubsite (specs, Widget) where
 
 import YesodCoreTest.YesodTest
 import Yesod.Core
 import qualified Network.HTTP.Types as H
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as B (concat)
+import qualified Data.ByteString.Lazy.Char8 as B8 (pack)
 
-myApp :: Application
-myApp _ f = f $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI"
+myApp :: ByteString -> Application
+myApp s _ f = f $ responseLBS H.status200 [("Content-type", "text/plain")] s
 
 getApp :: a -> WaiSubsite
-getApp _ = WaiSubsite myApp
+getApp _ = WaiSubsite $ myApp "WAI"
+
+getAppArgs :: a -> Int -> Int -> WaiSubsite
+getAppArgs _ i j = WaiSubsite $ myApp $ B.concat ["WAI - ", B8.pack $ show i, " - ", B8.pack $ show j ]
 
 data Y = Y
 mkYesod "Y" [parseRoutes|
@@ -17,6 +23,8 @@ mkYesod "Y" [parseRoutes|
 /sub WaiSubsiteR WaiSubsite getApp
 /nested NestedR:
   /sub NestedWaiSubsiteR WaiSubsite getApp
+/nestedargs/#Int NestedArgsR:
+  /sub/#Int NestedArgsWaiSubsiteR WaiSubsite getAppArgs
 |]
 
 instance Yesod Y
@@ -43,3 +51,8 @@ specs = describe "WaiSubsite" $ do
       res <- request defaultRequest { pathInfo = ["nested", "sub", "foo"] }
       assertStatus 200 res
       assertBodyContains "WAI" res
+
+    it "nested subsite with arguments" $ app $ do
+      res <- request defaultRequest { pathInfo = ["nestedargs", "1", "sub", "2", "foo"] }
+      assertStatus 200 res
+      assertBodyContains "WAI - 1 - 2" res