From 99c0eb060bfe2a64f69b68d2502b34f0ddb10503 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 19 Apr 2010 23:25:27 -0700
Subject: [PATCH] Added type signatures for mkYesodSub

---
 Yesod/Helpers/Auth.hs   | 17 +++++++++--------
 Yesod/Helpers/Static.hs |  8 +-------
 Yesod/Resource.hs       | 23 ++++++++++++++++++-----
 3 files changed, 28 insertions(+), 20 deletions(-)

diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index bb6f6428..1530ec3e 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -39,7 +39,7 @@ import Control.Monad.Attempt
 import qualified Data.ByteString.Char8 as B8
 import Data.Maybe
 
-import qualified Network.Wai as W
+--FIXME import qualified Network.Wai as W
 import Data.Typeable (Typeable)
 import Control.Exception (Exception)
 import Control.Applicative ((<$>))
@@ -48,6 +48,9 @@ import Control.Applicative ((<$>))
 
 data LoginType = OpenId | Rpxnow
 
+class Yesod y => YesodAuth y where
+    onRpxnowLogin :: Rpxnow.Identifier -> GHandler Auth y ()
+
 data Auth = Auth
     { defaultDest :: String
     --, onRpxnowLogin :: Rpxnow.Identifier -> GHandler Auth master ()
@@ -55,7 +58,7 @@ data Auth = Auth
     , defaultLoginType :: LoginType
     }
 
-$(mkYesodSub "Auth" [$parseRoutes|
+$(mkYesodSub "Auth" [''YesodAuth] [$parseRoutes|
 /check                 Check              GET
 /logout                Logout             GET
 /openid                OpenIdR            GET
@@ -126,7 +129,7 @@ getOpenIdComplete = do
         redirectToDest RedirectTemporary $ defaultDest y
     attempt onFailure onSuccess res
 
-handleRpxnowR :: GHandler Auth master ()
+handleRpxnowR :: YesodAuth master => GHandler Auth master ()
 handleRpxnowR = do
     ay <- getYesod
     apiKey <- case rpxnowApiKey ay of
@@ -145,11 +148,7 @@ handleRpxnowR = do
                         (s:_) -> s
                 (d:_) -> d
     ident <- liftIO $ Rpxnow.authenticate apiKey token
-    auth <- getYesod
-    {- FIXME onRpxnowLogin
-    case auth of
-        Auth _ f _ _ _ -> f ident
-    -}
+    onRpxnowLogin ident
     header authCookieName $ Rpxnow.identifier ident
     header authDisplayName $ getDisplayName ident
     redirectToDest RedirectTemporary dest
@@ -214,6 +213,7 @@ redirectLogin = do
                 Rpxnow -> RpxnowR -- FIXME this doesn't actually show a login page?
     redirectSetDest RedirectTemporary r
 
+{- FIXME
 -- | Determinge the path requested by the user (ie, the path info). This
 -- includes the query string.
 requestPath :: (Functor m, Monad m, RequestReader m) => m String --FIXME unused
@@ -227,6 +227,7 @@ requestPath = do
       where
         dropSlash ('/':x) = x
         dropSlash x = x
+-}
 
 -- | Redirect to the given URL, and set a cookie with the current URL so the
 -- user will ultimately be sent back here.
diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
index 184ca175..23dbd047 100644
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -33,7 +33,6 @@ import Control.Monad
 import Yesod
 import Data.List (intercalate)
 import Network.Wai
-import Web.Routes
 
 type FileLookup = FilePath -> IO (Maybe (Either FilePath Content))
 
@@ -43,15 +42,10 @@ staticArgs :: FileLookup -> Static
 staticArgs = Static
 
 -- FIXME bug in web-routes-quasi generates warning here
-$(mkYesodSub "Static" [$parseRoutes|
+$(mkYesodSub "Static" [] [$parseRoutes|
 /* StaticRoute GET
 |])
 
-siteStatic' :: Site StaticRoutes (String -> YesodApp
-    -> (master, master -> Static, StaticRoutes -> Routes master, Routes master -> String)
-    -> YesodApp)
-siteStatic' = siteStatic
-
 -- | A 'FileLookup' for files in a directory. Note that this function does not
 -- check if the requested path does unsafe things, eg expose hidden files. You
 -- should provide this checking elsewhere.
diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs
index bc520b56..046107d3 100644
--- a/Yesod/Resource.hs
+++ b/Yesod/Resource.hs
@@ -29,17 +29,30 @@ mkYesod name res = do
                 }
     return [tySyn, yes, x, y, z]
 
-mkYesodSub :: String -> [Resource] -> Q [Dec]
-mkYesodSub name res = do
+mkYesodSub :: String -> [Name] -> [Resource] -> Q [Dec]
+mkYesodSub name ctxs res = do
     let name' = mkName name
     let site = mkName $ "site" ++ name
     let tySyn = TySynInstD ''Routes [ConT name'] (ConT $ mkName $ name ++ "Routes")
-    CreateRoutesResult x _ z <- createRoutes $ CreateRoutesSettings
+    let sa = ConT (mkName name)
+    let man = mkName "master"
+    let ma = VarT man -- FIXME
+    let sr = ConT $ mkName $ name ++ "Routes"
+    let mr = ConT ''Routes `AppT` VarT man
+    let arg = TupleT 4
+                `AppT` ma
+                `AppT` (ArrowT `AppT` ma `AppT` sa)
+                `AppT` (ArrowT `AppT` sr `AppT` mr)
+                `AppT` (ArrowT `AppT` mr `AppT` ConT ''String)
+    CreateRoutesResult x (SigD yname y) z <- createRoutes $ CreateRoutesSettings
                 { crRoutes = mkName $ name ++ "Routes"
                 , crApplication = ConT ''YesodApp
-                , crArgument = ConT $ mkName name
+                , crArgument = arg
                 , crExplode = VarE $ mkName "runHandlerSub'"
                 , crResources = res
                 , crSite = site
                 }
-    return [tySyn, x, z]
+    let helper claz = ClassP claz [VarT man]
+    let ctxs' = map helper ctxs
+    let y' = ForallT [PlainTV man] ctxs' y
+    return [tySyn, x, SigD yname y', z]