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