diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index 1e6854e5..44164438 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/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 diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 68c1a8eb..105ab62f 100644 --- a/Yesod/Helpers/Auth.hs +++ b/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 diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index a22f26f4..2a29e104 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/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 diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 30ff6e41..25f5e0f3 100644 --- a/Yesod/Yesod.hs +++ b/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