Fixed helloworld
This commit is contained in:
parent
3f99bf132c
commit
b0e5cf56e5
@ -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.
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user