Added Approot newtype

This commit is contained in:
Michael Snoyman 2009-12-11 13:18:50 +02:00
parent 0fcfa1b9d8
commit 2eb6f2f05b
2 changed files with 9 additions and 3 deletions

View File

@ -17,6 +17,7 @@ module Yesod.Definitions
( Verb (..) ( Verb (..)
, toVerb , toVerb
, Resource , Resource
, Approot (..)
) where ) where
import qualified Hack import qualified Hack
@ -31,3 +32,8 @@ toVerb Hack.POST = Post
toVerb _ = Get toVerb _ = Get
type Resource = [String] type Resource = [String]
-- | An absolute URL to the base of this application. This can almost be done
-- programatically, but due to ambiguities in different ways of doing URL
-- rewriting for (fast)cgi applications, it should be supplied by the user.
newtype Approot = Approot { unApproot :: String }

View File

@ -22,6 +22,7 @@ module Yesod.Helpers.Sitemap
, SitemapChangeFreq (..) , SitemapChangeFreq (..)
) where ) where
import Yesod.Definitions
import Yesod.Handler import Yesod.Handler
import Yesod.Response import Yesod.Response
import Web.Encodings import Web.Encodings
@ -92,7 +93,6 @@ sitemap urls' = do
urls <- liftIO urls' urls <- liftIO urls'
return $ reps $ SitemapResponse req urls return $ reps $ SitemapResponse req urls
robots :: Handler robots :: Approot -> Handler
robots = do robots (Approot ar) = do
ar <- approot
return $ genResponse "text/plain" $ "Sitemap: " ++ ar ++ "sitemap.xml" return $ genResponse "text/plain" $ "Sitemap: " ++ ar ++ "sitemap.xml"