Compiling again

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

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

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)

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