From 9991e307e3ba3caa83d44fdfcc705e2b679676d8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20D=C3=ADaz?= <dhelta.diaz@gmail.com>
Date: Thu, 6 Aug 2015 00:13:28 +0200
Subject: [PATCH] Attempt to add support for parametrized types in mkYesod.

---
 yesod-core/Yesod/Core/Internal/TH.hs | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs
index 7e84c1cb..1a9fcf91 100644
--- a/yesod-core/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/Yesod/Core/Internal/TH.hs
@@ -15,6 +15,7 @@ import qualified Network.Wai as W
 
 import Data.ByteString.Lazy.Char8 ()
 import Data.List (foldl')
+import Control.Monad (replicateM)
 
 import Yesod.Routes.TH
 import Yesod.Routes.Parse
@@ -65,6 +66,18 @@ mkYesodGeneral :: String                   -- ^ foundation type
                -> [ResourceTree String]
                -> Q([Dec],[Dec])
 mkYesodGeneral name args isSub resS = do
+    info <- reify $ mkName name
+    let arity =
+          case info of
+            TyConI dec ->
+              case dec of
+                DataD _ _ vs _ _ -> length vs
+                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)
+        res = map (fmap parseType) resS
     renderRouteDec <- mkRenderRouteInstance site res
     routeAttrsDec  <- mkRouteAttrsInstance site res
     dispatchDec    <- mkDispatchInstance site res
@@ -83,8 +96,6 @@ mkYesodGeneral name args isSub resS = do
             , if isSub then [] else masterTypeSyns site
             ]
     return (dataDec, dispatchDec)
-  where site    = foldl' AppT (ConT $ mkName name) (map (VarT . mkName) args)
-        res     = map (fmap parseType) resS
 
 mkMDS :: Q Exp -> MkDispatchSettings
 mkMDS rh = MkDispatchSettings