Fix incorrect code generation for polymorphic datatypes

yesod-core/src/Yesod/Core/Internal/TH.hs

@@ -141,9 +141,12 @@ mkYesodGeneral appCxt' namestr mtys isSub f resS = do
     let name = mkName namestr
     -- Generate as many variable names as the arity indicates
     vns <- replicateM (arity - length mtys) $ newName "t"
-        -- Base type (site type with variables)
+    -- types that you apply to get a concrete site name
     let argtypes = fmap nameToType mtys ++ fmap VarT vns
-        site = foldl' AppT (ConT name) argtypes
+    -- typevars that should appear in synonym head
+    let argvars = (fmap mkName . filter isTvar) mtys ++ vns
+        -- Base type (site type with variables)
+    let site = foldl' AppT (ConT name) argtypes
         res = map (fmap (parseType . dropBracket)) resS
     renderRouteDec <- mkRenderRouteInstance appCxt site res
     routeAttrsDec  <- mkRouteAttrsInstance appCxt site res
@@ -160,7 +163,7 @@ mkYesodGeneral appCxt' namestr mtys isSub f resS = do
             , renderRouteDec
             , [routeAttrsDec]
             , resourcesDec
-            , if isSub then [] else masterTypeSyns vns site
+            , if isSub then [] else masterTypeSyns argvars site
             ]
     return (dataDec, dispatchDec)
 

yesod-core/src/Yesod/Routes/Parse.hs

@@ -11,6 +11,7 @@ module Yesod.Routes.Parse
     , TypeTree (..)
     , dropBracket
     , nameToType
+    , isTvar
     ) where
 
 import Language.Haskell.TH.Syntax
@@ -264,8 +265,13 @@ ttToType (TTApp x y) = ttToType x `AppT` ttToType y
 ttToType (TTList t) = ListT `AppT` ttToType t
 
 nameToType :: String -> Type
-nameToType t@(h:_) | isLower h = VarT $ mkName t
-nameToType t = ConT $ mkName t
+nameToType t = if isTvar t
+               then VarT $ mkName t
+               else ConT $ mkName t
+
+isTvar :: String -> Bool
+isTvar (h:_) = isLower h
+isTvar _     = False
 
 pieceFromString :: String -> Either (CheckOverlap, String) (CheckOverlap, Piece String)
 pieceFromString ('#':'!':x) = Right $ (False, Dynamic $ dropBracket x)