From 3ed97f4cfca3793905ee43caceeb00356f83649c Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 1 Jul 2010 17:55:00 +0300
Subject: [PATCH] Switch Routes back to type family.

There appears to be a bug in GHC, but I'm not certain. Look at the
output from compiling the previous commit; some kind of interaction with
a DataInstD and deriving instances.
---
 Yesod/Dispatch.hs       | 8 +++++---
 Yesod/Handler.hs        | 2 +-
 Yesod/Helpers/Auth.hs   | 4 ++--
 Yesod/Helpers/Crud.hs   | 2 +-
 Yesod/Helpers/Static.hs | 2 +-
 Yesod/Yesod.hs          | 4 ++--
 6 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index 01e82cd5..dcf46e4a 100644
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -141,7 +141,9 @@ mkYesodGeneral name args clazzes isSub res = do
                  $ map (\x -> (x, [])) ("master" : args) ++ clazzes
     th <- mapM (thResourceFromResource arg) res -- FIXME now we cannot have multi-nested subsites
     w' <- createRoutes th
-    let w = DataInstD [] ''Routes [arg] w' [''Show, ''Read, ''Eq]
+    let routesName = mkName $ name ++ "Routes"
+    let w = DataD [] routesName [] w' [''Show, ''Read, ''Eq]
+    let x = TySynInstD ''Routes [arg] $ ConT routesName
 
     parse' <- createParse th
     parse'' <- newName "parse"
@@ -166,7 +168,7 @@ mkYesodGeneral name args clazzes isSub res = do
     let y = InstanceD ctx ytyp
                 [ FunD (mkName yfunc) [Clause [] (NormalB site') []]
                 ]
-    return ([w], [y])
+    return ([w, x], [y])
 
 isStatic :: Piece -> Bool
 isStatic StaticPiece{} = True
@@ -248,7 +250,7 @@ toWaiApp' y segments env = do
         eurl = parsePathSegments site pathSegments
         render u = fromMaybe
                     (fullRender (approot y) (formatPathSegments site) u)
-                    (urlRenderOverride u)
+                    (urlRenderOverride y u)
     rr <- parseWaiRequest env session'
     let h = do
           onRequest
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
index af3e7045..6b1f4e3a 100644
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -96,7 +96,7 @@ import Numeric (showIntAtBase)
 import Data.Char (ord, chr)
 
 -- | The type-safe URLs associated with a site argument.
-data family Routes a
+type family Routes a
 
 data HandlerData sub master = HandlerData
     { handlerRequest :: Request
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index 32d91c91..3de63fd4 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -22,7 +22,7 @@
 module Yesod.Helpers.Auth
     ( -- * Subsite
       Auth (..)
-    , Routes (..)
+    , AuthRoutes (..)
       -- * Settings
     , YesodAuth (..)
     , Creds (..)
@@ -154,7 +154,7 @@ mkYesodSub "Auth" [("master", [''YesodAuth])] [$parseRoutes|
 /facebook/start          StartFacebookR     GET
 
 /register                EmailRegisterR     GET POST
-/verify/#EmailId/#String EmailVerifyR       GET
+/verify/#Integer/#String EmailVerifyR       GET
 /login                   EmailLoginR        GET POST
 /set-password            EmailPasswordR     GET POST
 |]
diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs
index e46e296d..9ebd8290 100644
--- a/Yesod/Helpers/Crud.hs
+++ b/Yesod/Helpers/Crud.hs
@@ -6,7 +6,7 @@
 module Yesod.Helpers.Crud
     ( Item (..)
     , Crud (..)
-    , Routes (..)
+    , CrudRoutes (..)
     , defaultCrud
     ) where
 
diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
index da0f3bc4..f62d4bac 100644
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -27,7 +27,7 @@
 module Yesod.Helpers.Static
     ( -- * Subsite
       Static (..)
-    , Routes (..)
+    , StaticRoutes (..)
       -- * Lookup files in filesystem
     , fileLookupDir
     , staticFiles
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index fb6fb806..7b17f149 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -93,8 +93,8 @@ class Yesod a where
     -- | Override the rendering function for a particular URL. One use case for
     -- this is to offload static hosting to a different domain name to avoid
     -- sending cookies.
-    urlRenderOverride :: Routes a -> Maybe String
-    urlRenderOverride _ = Nothing
+    urlRenderOverride :: a -> Routes a -> Maybe String
+    urlRenderOverride _ _ = Nothing
 
     -- | Determine if a request is authorized or not.
     --