diff --git a/Yesod/Definitions.hs b/Yesod/Definitions.hs index 6c7238f1..c1e1d196 100644 --- a/Yesod/Definitions.hs +++ b/Yesod/Definitions.hs @@ -15,8 +15,7 @@ -- --------------------------------------------------------- module Yesod.Definitions - ( Resource - , Approot + ( Approot , Language , Location (..) , showLocation @@ -31,8 +30,6 @@ module Yesod.Definitions import Data.ByteString.Char8 (pack, ByteString) -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. diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 86a65762..b506b184 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -67,8 +67,6 @@ class YesodSite a => Yesod a where onRequest :: a -> Request -> IO () onRequest _ _ = return () - badMethod :: a -> YesodApp a -- FIXME include in errorHandler - -- | An absolute URL to the root of the application. Do not include -- trailing slash. approot :: a -> Approot @@ -140,14 +138,15 @@ toWaiApp' :: Yesod y -> W.Request -> IO W.Response toWaiApp' y resource session env = do - let site = getSite getMethod (badMethod y) y + let site = getSite getMethod badMethod y types = httpAccept env - pathSegments = cleanupSegments resource + pathSegments = filter (not . null) $ cleanupSegments resource eurl = parsePathSegments site pathSegments render u = approot y ++ '/' : encodePathInfo (formatPathSegments site u) rr <- parseWaiRequest env session onRequest y rr + print pathSegments let ya = case eurl of Left _ -> runHandler (errorHandler NotFound) y render Right url -> handleSite site render url @@ -179,3 +178,7 @@ basicHandler port app = do putStrLn $ "http://localhost:" ++ show port ++ "/" SS.run port app Just _ -> CGI.run app + +badMethod :: YesodApp y +badMethod _ _ _ = return $ Response W.Status405 [] TypePlain + $ cs "Method not supported" diff --git a/examples/helloworld.lhs b/examples/helloworld.lhs index a676612a..beb022ca 100644 --- a/examples/helloworld.lhs +++ b/examples/helloworld.lhs @@ -1,18 +1,23 @@ \begin{code} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} import Yesod import Network.Wai.Handler.SimpleServer +import qualified Web.Routes.Quasi data HelloWorld = HelloWorld -instance Yesod HelloWorld where - resources = [$mkResources| -/: - Get: helloWorld + +mkYesod "HelloWorld" [$parseRoutes| +/ Home GET |] -helloWorld :: Handler HelloWorld ChooseRep -helloWorld = applyLayout' "Hello World" $ cs "Hello world!" +instance Yesod HelloWorld where + approot _ = "http://localhost:3000" + +getHome :: Handler HelloWorld ChooseRep +getHome = applyLayout' "Hello World" $ cs "Hello world!" main :: IO () main = putStrLn "Running..." >> toWaiApp HelloWorld >>= run 3000