From bab00d13fade0d7b36bf31fdb847031a8e0484a7 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 22 Aug 2011 19:30:55 +0300
Subject: [PATCH] TH defines Widget and Handler type synonyms

---
 yesod-core/Test/Widget.hs            |  3 ++-
 yesod-core/Yesod/Dispatch.hs         | 20 +++++++++++++++++---
 yesod/scaffold/Foundation.hs.cg      |  8 --------
 yesod/scaffold/tiny/Foundation.hs.cg |  8 --------
 4 files changed, 19 insertions(+), 20 deletions(-)

diff --git a/yesod-core/Test/Widget.hs b/yesod-core/Test/Widget.hs
index 76988914..7d45869e 100644
--- a/yesod-core/Test/Widget.hs
+++ b/yesod-core/Test/Widget.hs
@@ -47,6 +47,7 @@ instance RenderMessage Y Msg where
     renderMessage a (_:xs) y = renderMessage a xs y
     renderMessage a [] y = renderMessage a ["en"] y
 
+getTowidgetR :: Handler RepHtml
 getTowidgetR = defaultLayout $ do
     toWidget [julius|foo|]
     toWidgetHead [julius|foo|]
@@ -55,7 +56,7 @@ getTowidgetR = defaultLayout $ do
     toWidget [lucius|foo{bar:baz}|]
     toWidgetHead [lucius|foo{bar:baz}|]
 
-    toWidget [hamlet|<foo>|]
+    toWidget [hamlet|<foo>|] :: Widget
     toWidgetHead [hamlet|<foo>|]
     toWidgetBody [hamlet|<foo>|]
 
diff --git a/yesod-core/Yesod/Dispatch.hs b/yesod-core/Yesod/Dispatch.hs
index de219d05..4421abc5 100644
--- a/yesod-core/Yesod/Dispatch.hs
+++ b/yesod-core/Yesod/Dispatch.hs
@@ -27,6 +27,7 @@ import Prelude hiding (exp)
 import Yesod.Internal.Core
 import Yesod.Handler
 import Yesod.Internal.Dispatch
+import Yesod.Widget (GWidget)
 
 import Web.PathPieces (SinglePiece (..), MultiPiece (..))
 import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesFile)
@@ -103,8 +104,7 @@ mkYesodGeneral :: String -- ^ foundation name
                -> [Resource]
                -> Q ([Dec], [Dec])
 mkYesodGeneral name args clazzes isSub res = do
-    let name' = mkName name
-        args' = map mkName args
+    let args' = map mkName args
         arg = foldl AppT (ConT name') $ map VarT args'
     th' <- mapM thResourceFromResource res
     let th = map fst th'
@@ -134,7 +134,21 @@ mkYesodGeneral name args clazzes isSub res = do
                 then ConT ''YesodDispatch `AppT` arg `AppT` VarT master
                 else ConT ''YesodDispatch `AppT` arg `AppT` arg
     let y = InstanceD ctx ytyp [FunD (mkName "yesodDispatch") [yd]]
-    return ([w, x, x'], [y])
+    return ([w, x, x'] ++ masterTypSyns, [y])
+  where
+    name' = mkName name
+    masterTypSyns
+        | isSub = []
+        | otherwise =
+            [ TySynD
+                (mkName "Handler")
+                []
+                (ConT ''GHandler `AppT` ConT name' `AppT` ConT name')
+            , TySynD
+                (mkName "Widget")
+                []
+                (ConT ''GWidget `AppT` ConT name' `AppT` ConT name' `AppT` TupleT 0)
+            ]
 
 thResourceFromResource :: Resource -> Q (THResource, Maybe String)
 thResourceFromResource (Resource n ps atts)
diff --git a/yesod/scaffold/Foundation.hs.cg b/yesod/scaffold/Foundation.hs.cg
index 88c9adb5..03badf3f 100644
--- a/yesod/scaffold/Foundation.hs.cg
+++ b/yesod/scaffold/Foundation.hs.cg
@@ -50,14 +50,6 @@ data ~sitearg~ = ~sitearg~
     , connPool :: Settings.ConnectionPool -- ^ Database connection pool.
     }
 
--- | A useful synonym; most of the handler functions in your application
--- will need to be of this type.
-type Handler = GHandler ~sitearg~ ~sitearg~
-
--- | A useful synonym; most of the widgets functions in your application
--- will need to be of this type.
-type Widget = GWidget ~sitearg~ ~sitearg~
-
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
 -- http://www.yesodweb.com/book/handler
diff --git a/yesod/scaffold/tiny/Foundation.hs.cg b/yesod/scaffold/tiny/Foundation.hs.cg
index d3555ac4..48365017 100644
--- a/yesod/scaffold/tiny/Foundation.hs.cg
+++ b/yesod/scaffold/tiny/Foundation.hs.cg
@@ -37,14 +37,6 @@ data ~sitearg~ = ~sitearg~
     , getStatic :: Static -- ^ Settings for static file serving.
     }
 
--- | A useful synonym; most of the handler functions in your application
--- will need to be of this type.
-type Handler = GHandler ~sitearg~ ~sitearg~
-
--- | A useful synonym; most of the widgets functions in your application
--- will need to be of this type.
-type Widget = GWidget ~sitearg~ ~sitearg~
-
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
 -- http://docs.yesodweb.com/book/web-routes-quasi/