Minor bug fixes

This commit is contained in:
Michael Snoyman 2009-09-21 23:26:43 +03:00
parent 0519b99fed
commit 85249b64e1
2 changed files with 10 additions and 9 deletions

View File

@ -116,21 +116,21 @@ toHackApplication :: RestfulApp resourceName model
-> Hack.Application
toHackApplication sampleRN hm env = do
let (Right resource) = splitPath $ Hack.pathInfo env
let (handler, urlParams') =
let (handler, urlParams', wrapper) =
case findResourceNames resource of
[] -> (notFound, [])
[] -> (notFound, [], const return)
[(rn, urlParams'')] ->
let verb = toVerb $ Hack.requestMethod env
in (hm rn verb, urlParams'')
in (hm rn verb, urlParams'', responseWrapper rn)
x -> error $ "Invalid findResourceNames: " ++ show x
let rr = envToRawRequest urlParams' env
let rawHttpAccept = tryLookup "" "Accept" $ Hack.http env
ctypes' = parseHttpAccept rawHttpAccept
runHandler (errorHandler sampleRN rr)
(responseWrapper sampleRN)
ctypes'
handler
rr
wrapper
ctypes'
handler
rr
envToRawRequest :: [(ParamName, ParamValue)] -> Hack.Env -> RawRequest
envToRawRequest urlParams' env =

View File

@ -88,7 +88,8 @@ instance HasReps SitemapResponse where
[ ("text/xml", toLazyByteString $ show res)
]
sitemap :: IO [SitemapUrl] -> SitemapRequest -> Handler
sitemap urls' req = do
sitemap :: IO [SitemapUrl] -> Handler
sitemap urls' = do
req <- getRequest
urls <- liftIO urls'
return $ reps $ SitemapResponse req urls