From ec2d63ce07512722b191e67280c45cf8619bd65b Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 17 Dec 2009 14:47:37 +0200 Subject: [PATCH] Compiling again --- Yesod/Helpers/Static.hs | 14 ++++++---- Yesod/Request.hs | 26 ++++------------- Yesod/Resource.hs | 4 +++ Yesod/Yesod.hs | 62 ++++------------------------------------- 4 files changed, 22 insertions(+), 84 deletions(-) diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index c7c06bc8..f0d98293 100644 --- a/Yesod/Helpers/Static.hs +++ b/Yesod/Helpers/Static.hs @@ -28,6 +28,7 @@ import Control.Applicative ((<$>)) import Yesod import Yesod.Rep +import Data.List (intercalate) type FileLookup = FilePath -> IO (Maybe B.ByteString) @@ -40,13 +41,14 @@ fileLookupDir dir fp = do then Just <$> B.readFile fp' else return Nothing -serveStatic :: FileLookup -> Verb -> Handler y [(ContentType, Content)] -serveStatic fl Get = getStatic fl -serveStatic _ _ = notFound +serveStatic :: FileLookup -> Verb -> [String] + -> Handler y [(ContentType, Content)] +serveStatic fl Get fp = getStatic fl fp +serveStatic _ _ _ = notFound -getStatic :: FileLookup -> Handler y [(ContentType, Content)] -getStatic fl = do - fp <- urlParam "filepath" -- FIXME check for .. +getStatic :: FileLookup -> [String] -> Handler y [(ContentType, Content)] +getStatic fl fp' = do + let fp = intercalate "/" fp' -- FIXME check for . or .. content <- liftIO $ fl fp case content of Nothing -> notFound diff --git a/Yesod/Request.hs b/Yesod/Request.hs index e8263a74..01cdf535 100644 --- a/Yesod/Request.hs +++ b/Yesod/Request.hs @@ -33,7 +33,6 @@ module Yesod.Request , MonadRequestReader (..) , getParam , postParam - , urlParam , anyParam , cookieParam , identifier @@ -76,7 +75,6 @@ import Control.Arrow ((***)) data ParamType = GetParam | PostParam - | UrlParam | CookieParam deriving (Eq, Show) @@ -158,11 +156,6 @@ getParam = genParam getParams GetParam postParam :: (Parameter a, MonadRequestReader m) => ParamName -> m a postParam = genParam postParams PostParam --- | Parse a value passed in the URL and extracted using rewrite. --- (FIXME: link to rewrite section.) -urlParam :: (Parameter a, MonadRequestReader m) => ParamName -> m a -urlParam = genParam urlParams UrlParam - -- | Parse a value passed as a GET, POST or URL parameter. anyParam :: (Parameter a, MonadRequestReader m) => ParamName -> m a anyParam = genParam anyParams PostParam -- FIXME @@ -217,7 +210,6 @@ type PathInfo = [String] -- | The raw information passed through Hack, cleaned up a bit. data RawRequest = RawRequest { rawPathInfo :: PathInfo - , rawUrlParams :: [(ParamName, ParamValue)] , rawGetParams :: [(ParamName, ParamValue)] , rawPostParams :: [(ParamName, ParamValue)] , rawCookies :: [(ParamName, ParamValue)] @@ -241,17 +233,9 @@ postParams rr name = map snd . rawPostParams $ rr --- | All URL paramater values (see rewriting) with the given name. -urlParams :: RawRequest -> ParamName -> [ParamValue] -urlParams rr name = map snd - . filter (\x -> name == fst x) - . rawUrlParams - $ rr - --- | All GET, POST and URL paramater values (see rewriting) with the given name. +-- | All GET and POST paramater values (see rewriting) with the given name. anyParams :: RawRequest -> ParamName -> [ParamValue] -anyParams req name = urlParams req name ++ - getParams req name ++ +anyParams req name = getParams req name ++ postParams req name -- | All cookies with the given name. @@ -325,8 +309,8 @@ notBlank rp = "" -> invalidParam (paramType rp) (paramName rp) "Required field" s -> return s -instance ConvertSuccess ([(ParamName, ParamValue)], Hack.Env) RawRequest where - convertSuccess (urlParams', env) = +instance ConvertSuccess Hack.Env RawRequest where + convertSuccess env = let (Right rawPieces) = splitPath $ Hack.pathInfo env gets' = decodeUrlPairs $ Hack.queryString env :: [(String, String)] clength = tryLookup "0" "Content-Length" $ Hack.http env @@ -339,4 +323,4 @@ instance ConvertSuccess ([(ParamName, ParamValue)], Hack.Env) RawRequest where rawCookie = tryLookup "" "Cookie" $ Hack.http env cookies' = decodeCookies rawCookie :: [(String, String)] langs = ["en"] -- FIXME - in RawRequest rawPieces urlParams' gets' posts cookies' files env langs + in RawRequest rawPieces gets' posts cookies' files env langs diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs index 7b67028e..3f0f8645 100644 --- a/Yesod/Resource.hs +++ b/Yesod/Resource.hs @@ -60,7 +60,11 @@ import Control.Monad ((<=<)) import Data.Object.Yaml import Yesod.Handler import Data.Maybe (fromJust) +#if TEST +import Yesod.Rep hiding (testSuite) +#else import Yesod.Rep +#endif #if TEST import Control.Monad (replicateM) diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 1afe1ff6..048cdad8 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -10,15 +10,11 @@ import Yesod.Response import Yesod.Request import Yesod.Constants import Yesod.Definitions -import Yesod.Resource import Yesod.Handler import Yesod.Utils import Data.Maybe (fromMaybe) import Data.Convertible.Text -import Web.Encodings -import Control.Arrow ((***), second) -import Control.Monad (when) import qualified Hack import Hack.Middleware.CleanPath @@ -28,7 +24,8 @@ import Hack.Middleware.Jsonp import Hack.Middleware.MethodOverride class Yesod a where - handlers :: [(ResourcePattern, [(Verb, Handler a RepChooser)])] + -- | Please use the Quasi-Quoter, you\'ll be happier. FIXME more info. + handlers :: Resource -> Verb -> Handler a RepChooser -- | The encryption key to be used for encrypting client sessions. encryptKey :: a -> IO Word256 @@ -38,10 +35,6 @@ class Yesod a where errorHandler :: ErrorResult -> Handler a RepChooser errorHandler = defaultErrorHandler - -- | Whether or not we should check for overlapping resource names. - checkOverlaps :: a -> Bool - checkOverlaps = const True - -- | An absolute URL to the root of the application. approot :: a -> Approot @@ -65,19 +58,8 @@ defaultErrorHandler (InternalError e) = [ ("Internal server error", e) ] --- | For type signature reasons. -handlers' :: Yesod y => y -> - [(ResourcePattern, [(Verb, Handler y RepChooser)])] -handlers' _ = handlers - toHackApp :: Yesod y => y -> Hack.Application toHackApp a env = do - -- FIXME figure out a way to do this check compile-time - when (checkOverlaps a) $ checkPatterns $ map fst $ handlers' a - toHackAppUnchecked a env - -toHackAppUnchecked :: Yesod y => y -> Hack.Application -toHackAppUnchecked a env = do key <- encryptKey a let app' = toHackApp' a middleware = @@ -94,12 +76,9 @@ toHackApp' :: Yesod y => y -> Hack.Application toHackApp' y env = do let (Right resource) = splitPath $ Hack.pathInfo env types = httpAccept env - (handler, urlParams') = fromMaybe (notFound, []) $ do - (verbPairs, urlParams'') <- lookupHandlers resource - let verb = cs $ Hack.requestMethod env - handler'' <- lookup verb verbPairs - return (handler'', urlParams'') - rr = envToRawRequest urlParams' env + verb = cs $ Hack.requestMethod env + handler = handlers resource verb + rr = cs env res <- runHandler handler errorHandler rr y types let langs = ["en"] -- FIXME responseToHackResponse langs res @@ -107,34 +86,3 @@ toHackApp' y env = do httpAccept :: Hack.Env -> [ContentType] httpAccept = map TypeOther . parseHttpAccept . fromMaybe "" . lookup "Accept" . Hack.http - -lookupHandlers :: Yesod y - => Resource - -> Maybe - ( [(Verb, Handler y RepChooser)] - , [(ParamName, ParamValue)] - ) -lookupHandlers r = helper handlers where - helper [] = Nothing - helper ((rps, v):rest) = - case checkPattern (cs rps) r of - Just up -> Just (v, map (second show) up) - Nothing -> helper rest - -envToRawRequest :: [(ParamName, ParamValue)] -> Hack.Env -> RawRequest -envToRawRequest urlParams' env = - let (Right rawPieces) = splitPath $ Hack.pathInfo env - gets' = decodeUrlPairs $ Hack.queryString env :: [(String, String)] - clength = fromMaybe "0" $ lookup "Content-Length" $ Hack.http env - ctype = fromMaybe "" $ lookup "Content-Type" $ Hack.http env - (posts, files) = map (cs *** cs) *** map (cs *** convertFileInfo) - $ parsePost ctype clength - $ Hack.hackInput env - rawCookie = fromMaybe "" $ lookup "Cookie" $ Hack.http env - cookies' = decodeCookies rawCookie :: [(String, String)] - langs = ["en"] -- FIXME - in RawRequest rawPieces urlParams' gets' posts cookies' files env langs - -convertFileInfo :: ConvertSuccess a b => FileInfo a c -> FileInfo b c -convertFileInfo (FileInfo a b c) = - FileInfo (convertSuccess a) (convertSuccess b) c