haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1144 from ajnsit/hierarchical-subsites

Browse Source 
Allow subsites within hierarchical routes
This commit is contained in:
Michael Snoyman 2016-01-14 09:34:00 +02:00
commit 8f2d92baab
2 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
yesod-core/Yesod/Routes/TH/Dispatch.hs
View File

@ -176,11 +176,12 @@ mkDispatchClause MkDispatchSettings {..} resources = do
subDispatcherE <- mdsSubDispatcher subDispatcherE <- mdsSubDispatcher
runHandlerE <- mdsRunHandler runHandlerE <- mdsRunHandler
sub <- newName "sub" sub <- newName "sub"
sroute <- newName "sroute"
let sub2 = LamE [VarP sub] 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) dyns)
let reqExp' = setPathInfoE `AppE` VarE restPath `AppE` reqExp let reqExp' = setPathInfoE `AppE` VarE restPath `AppE` reqExp
route' = foldl' AppE (ConE (mkName name)) dyns 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 exp = subDispatcherE
`AppE` runHandlerE `AppE` runHandlerE
`AppE` sub2 `AppE` sub2

7
yesod-core/test/YesodCoreTest/WaiSubsite.hs
View File

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