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

Allow Site types to have type parameters.

Browse Source
This commit is contained in:
Daniel Díaz 2015-08-06 00:35:48 +02:00
parent 9991e307e3
commit 366bfbd319
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
yesod-core/Yesod/Core/Internal/TH.hs
View File

@ -52,11 +52,11 @@ mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False
-- | Get the Handler and Widget type synonyms for the given site.
masterTypeSyns :: Type -> [Dec]
masterTypeSyns site =
[ TySynD (mkName "Handler") []
masterTypeSyns :: [Name] -> Type -> [Dec]
masterTypeSyns vs site =
[ TySynD (mkName "Handler") (fmap PlainTV vs)
$ ConT ''HandlerT `AppT` site `AppT` ConT ''IO
, TySynD (mkName "Widget") []
, TySynD (mkName "Widget") (fmap PlainTV vs)
$ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
]
@ -75,8 +75,13 @@ mkYesodGeneral name args isSub resS = do
NewtypeD _ _ vs _ _ -> length vs
_ -> 0
_ -> 0
vs <- fmap (fmap VarT) $ replicateM arity $ newName "t"
let site = foldl' AppT (foldl' AppT (ConT $ mkName name) vs) (map (VarT . mkName) args)
-- Generate as many variable names as the arity indicates
vns <- replicateM arity $ newName "t"
-- Variables for type parameters
let vs = fmap VarT vns
-- Base type (site type with variables)
basety = foldl' AppT (ConT $ mkName name) vs
site = foldl' AppT basety (map (VarT . mkName) args)
res = map (fmap parseType) resS
renderRouteDec <- mkRenderRouteInstance site res
routeAttrsDec <- mkRouteAttrsInstance site res
@ -93,7 +98,7 @@ mkYesodGeneral name args isSub resS = do
, renderRouteDec
, [routeAttrsDec]
, resourcesDec
, if isSub then [] else masterTypeSyns site
, if isSub then [] else masterTypeSyns vns site
]
return (dataDec, dispatchDec)