dynamic subsites

Yesod/Dispatch.hs

@@ -162,7 +162,7 @@ mkYesodGeneral name args clazzes isSub res = do
     render'' <- newName "render"
     let render = LetE [FunD render'' render'] $ VarE render''
 
-    tmh <- [|toMasterHandler|]
+    tmh <- [|toMasterHandlerDyn|]
     modMaster <- [|fmap chooseRep|]
     dispatch' <- createDispatch modMaster tmh th
     dispatch'' <- newName "dispatch"
@@ -188,10 +188,11 @@ fromStatic (StaticPiece s) = s
 fromStatic _ = error "fromStatic"
 
 thResourceFromResource :: Type -> Resource -> Q THResource
-thResourceFromResource _ (Resource n ps attribs)
+thResourceFromResource _ (Resource n ps atts)
-    | all (all isUpper) attribs = return (n, Simple ps attribs)
+    | all (all isUpper) atts = return (n, Simple ps atts)
 thResourceFromResource master (Resource n ps atts@[stype, toSubArg])
-    | all isStatic ps && any (any isLower) atts = do
+    -- static route to subsite
+    = do
         let stype' = ConT $ mkName stype
         gss <- [|getSubSite|]
         let inside = ConT ''Maybe `AppT`
@@ -213,8 +214,9 @@ thResourceFromResource master (Resource n ps atts@[stype, toSubArg])
             , ssRender = render
             , ssDispatch = dispatch
             , ssToMasterArg = VarE $ mkName toSubArg
-            , ssPieces = map fromStatic ps
+            , ssPieces = ps
             })
+
 thResourceFromResource _ (Resource n _ _) =
     error $ "Invalid attributes for resource: " ++ n
 

Yesod/Handler.hs

@@ -77,6 +77,7 @@ module Yesod.Handler
     , runHandler
     , YesodApp (..)
     , toMasterHandler
+    , toMasterHandlerDyn
     , toMasterHandlerMaybe
     , localNoCurrent
     , HandlerData
@@ -166,6 +167,15 @@ toMasterHandler :: (Route sub -> Route master)
 toMasterHandler tm ts route (GHandler h) =
     GHandler $ withReaderT (handlerSubData tm ts route) h
 
+toMasterHandlerDyn :: (Route sub -> Route master)
+                   -> GHandler sub' master sub
+                   -> Route sub
+                   -> GHandler sub master a
+                   -> GHandler sub' master a
+toMasterHandlerDyn tm getSub route (GHandler h) = do
+    sub <- getSub
+    GHandler $ withReaderT (handlerSubData tm (const sub) route) h
+
 toMasterHandlerMaybe :: (Route sub -> Route master)
                      -> (master -> sub)
                      -> Maybe (Route sub)

Yesod/Yesod.hs

@@ -87,6 +87,8 @@ type Method = String
 -- to deal with it directly, as the mkYesodSub creates instances appropriately.
 class Eq (Route s) => YesodSubSite s y where
     getSubSite :: Site (Route s) (Method -> Maybe (GHandler s y ChooseRep))
+    getSiteFromSubSite :: s -> Site (Route s) (Method -> Maybe (GHandler s y ChooseRep))
+    getSiteFromSubSite _ = getSubSite
 
 -- | Define settings for a Yesod applications. The only required setting is
 -- 'approot'; other than that, there are intelligent defaults.