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

mkRenderRouteInstance should be passed full foundation type

Browse Source
This commit is contained in:
Corey O'Connor 2012-02-04 11:38:16 -08:00
parent 1c3b63b3a1
commit e650df437e
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
yesod-core/Yesod/Dispatch.hs
View File

@ -103,23 +103,23 @@ mkYesodSubDispatch :: String -> Cxt -> [Resource String] -> Q [Dec]
mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True
where (name':rest) = words name where (name':rest) = words name
mkYesodGeneral :: String -- ^ foundation name mkYesodGeneral :: String -- ^ foundation type
-> [String] -- ^ parameters for foundation -> [String]
-> Cxt -- ^ classes -> Cxt -- ^ classes
-> Bool -- ^ is subsite? -> Bool -- ^ is subsite?
-> [Resource String] -> [Resource String]
-> Q ([Dec], [Dec]) -> Q ([Dec], [Dec])
mkYesodGeneral name args clazzes isSub resS = do mkYesodGeneral name args clazzes isSub resS = do
let args' = map mkName args
arg = foldl AppT (ConT name') $ map VarT args'
let res = map (fmap parseType) resS let res = map (fmap parseType) resS
renderRouteDec <- mkRenderRouteInstance (ConT name') res renderRouteDec <- mkRenderRouteInstance arg res
disp <- mkDispatchClause [|yesodRunner|] [|yesodDispatch|] [|fmap chooseRep|] res disp <- mkDispatchClause [|yesodRunner|] [|yesodDispatch|] [|fmap chooseRep|] res
let master = mkName "master" let master = mkName "master"
let ctx = if isSub let ctx = if isSub
then ClassP (mkName "Yesod") [VarT master] : clazzes then ClassP (mkName "Yesod") [VarT master] : clazzes
else [] else []
let args' = map mkName args
arg = foldl AppT (ConT name') $ map VarT args'
let ytyp = if isSub let ytyp = if isSub
then ConT ''YesodDispatch `AppT` arg `AppT` VarT master then ConT ''YesodDispatch `AppT` arg `AppT` VarT master
else ConT ''YesodDispatch `AppT` arg `AppT` arg else ConT ''YesodDispatch `AppT` arg `AppT` arg