Added type signatures for mkYesodSub

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
+    onRpxnowLogin ident
-    {- FIXME onRpxnowLogin
-    case auth of
-        Auth _ f _ _ _ -> f 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.

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.

Yesod/Resource.hs

@@ -29,17 +29,30 @@ mkYesod name res = do
                 }
     return [tySyn, yes, x, y, z]
 
-mkYesodSub :: String -> [Resource] -> Q [Dec]
+mkYesodSub :: String -> [Name] -> [Resource] -> Q [Dec]
-mkYesodSub name res = do
+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]