Merge pull request #1144 from ajnsit/hierarchical-subsites

Allow subsites within hierarchical routes

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

@@ -176,11 +176,12 @@ mkDispatchClause MkDispatchSettings {..} resources = do
                     subDispatcherE <- mdsSubDispatcher
                     runHandlerE <- mdsRunHandler
                     sub <- newName "sub"
+                    sroute <- newName "sroute"
                     let sub2 = LamE [VarP sub]
                             (foldl' (\a b -> a `AppE` b) (VarE (mkName getSub) `AppE` VarE sub) dyns)
                     let reqExp' = setPathInfoE `AppE` VarE restPath `AppE` reqExp
                         route' = foldl' AppE (ConE (mkName name)) dyns
-                        route = foldr AppE route' extraCons
+                        route = LamE [VarP sroute] $ foldr AppE (AppE route' $ VarE sroute) extraCons
                         exp = subDispatcherE
                             `AppE` runHandlerE
                             `AppE` sub2

yesod-core/test/YesodCoreTest/WaiSubsite.hs

@@ -15,6 +15,8 @@ data Y = Y
 mkYesod "Y" [parseRoutes|
 / RootR GET
 /sub WaiSubsiteR WaiSubsite getApp
+/nested NestedR:
+  /sub NestedWaiSubsiteR WaiSubsite getApp
 |]
 
 instance Yesod Y
@@ -36,3 +38,8 @@ specs = describe "WaiSubsite" $ do
       res <- request defaultRequest { pathInfo = ["sub", "foo"] }
       assertStatus 200 res
       assertBodyContains "WAI" res
+
+    it "nested subsite" $ app $ do
+      res <- request defaultRequest { pathInfo = ["nested", "sub", "foo"] }
+      assertStatus 200 res
+      assertBodyContains "WAI" res