Proper render function; removed YesodApproot

Yesod/Helpers/AtomFeed.hs

@@ -27,7 +27,7 @@ import Web.Encodings (formatW3)
 
 data AtomFeedResponse = AtomFeedResponse AtomFeed Approot
 
-atomFeed :: YesodApproot y => AtomFeed -> Handler y AtomFeedResponse
+atomFeed :: Yesod y => AtomFeed -> Handler y AtomFeedResponse
 atomFeed f = do
     y <- getYesod
     return $ AtomFeedResponse f $ approot y

Yesod/Helpers/Auth.hs

@@ -40,7 +40,7 @@ import Control.Applicative ((<$>))
 
 -- FIXME check referer header to determine destination
 
-class YesodApproot a => YesodAuth a where
+class Yesod a => YesodAuth a where
     -- | The following breaks DRY, but I cannot think of a better solution
     -- right now.
     --
@@ -134,7 +134,7 @@ authOpenidForward = do
       (redirect RedirectTemporary)
       res
 
-authOpenidComplete :: YesodApproot y => Handler y ()
+authOpenidComplete :: Yesod y => Handler y ()
 authOpenidComplete = do
     rr <- getRequest
     let gets' = reqGetParams rr
@@ -239,7 +239,7 @@ requestPath = do
 
 -- | Redirect to the given URL, and set a cookie with the current URL so the
 -- user will ultimately be sent back here.
-redirectSetDest :: YesodApproot y => RedirectType -> String -> Handler y a
+redirectSetDest :: Yesod y => RedirectType -> String -> Handler y a
 redirectSetDest rt dest = do
     ar <- getApproot
     rp <- requestPath

Yesod/Helpers/Sitemap.hs

@@ -73,12 +73,12 @@ instance HasReps SitemapResponse where
         [ (TypeXml, return . cs)
         ]
 
-sitemap :: YesodApproot y => [SitemapUrl] -> Handler y SitemapResponse
+sitemap :: Yesod y => [SitemapUrl] -> Handler y SitemapResponse
 sitemap urls = do
     yesod <- getYesod
     return $ SitemapResponse urls $ approot yesod
 
-robots :: YesodApproot yesod => Handler yesod [(ContentType, Content)]
+robots :: Yesod yesod => Handler yesod [(ContentType, Content)]
 robots = do
     yesod <- getYesod
     return $ staticRep TypePlain $ "Sitemap: " ++ showLocation

Yesod/Yesod.hs

@@ -2,7 +2,6 @@
 module Yesod.Yesod
     ( Yesod (..)
     , YesodSite (..)
-    , YesodApproot (..)
     , applyLayout'
     , applyLayoutJson
     , getApproot
@@ -21,7 +20,7 @@ import qualified Data.ByteString as B
 import Data.Maybe (fromMaybe)
 import Web.Mime
 import Web.Encodings (parseHttpAccept)
-import Web.Routes (Site (..))
+import Web.Routes (Site (..), encodePathInfo)
 
 import qualified Network.Wai as W
 import Network.Wai.Middleware.CleanPath
@@ -66,10 +65,10 @@ class YesodSite a => Yesod a where
     onRequest :: a -> Request -> IO ()
     onRequest _ _ = return ()
 
-    badMethod :: a -> YesodApp a
+    badMethod :: a -> YesodApp a -- FIXME include in errorHandler
 
-class Yesod a => YesodApproot a where
-    -- | An absolute URL to the root of the application.
+    -- | An absolute URL to the root of the application. Do not include
+    -- trailing slash.
     approot :: a -> Approot
 
 -- | A convenience wrapper around 'applyLayout'.
@@ -98,7 +97,7 @@ applyLayoutJson t b = do
         , (TypeJson, cs $ unJsonDoc $ cs b)
         ]
 
-getApproot :: YesodApproot y => Handler y Approot
+getApproot :: Yesod y => Handler y Approot
 getApproot = approot `fmap` getYesod
 
 defaultErrorHandler :: Yesod y
@@ -148,7 +147,8 @@ toWaiApp' y resource session env = do
         Right url -> do
             rr <- parseWaiRequest env session
             onRequest y rr
-            let render = error "FIXME: render" -- use formatPathSegments
+            let render u = approot y ++ '/'
+                         : encodePathInfo (formatPathSegments site u)
             res <- handleSite site render url errorHandler rr types
             responseToWaiResponse res