Commits

Luke Plant  committed a663bfe

More experimental routing mechanism

  • Participants
  • Parent commits 1eb03c0

Comments (0)

Files changed (3)

File src/Web/Framework.hs

                      , defaultDispatchOptions
                      , View
                      , matchPath
+                     , matchStringParam
                      )
 
 where
 matchPath path view = \req -> if path `isPrefixOf` (pathInfo req)
                               then view req
                               else return Nothing
+
+matchStringParam :: (String -> View) -> View
+matchStringParam f = \req -> f (pathInfo req) req

File src/Web/Utils.hs

 import GHC.Exts( IsString(..) )
 instance IsString ByteString where
     fromString = UTF8.fromString
+
+utf8 = UTF8.fromString

File testsuite/tests/Tests/Web/Framework.hs

 import Web.Response
 import Data.Maybe (isNothing, isJust)
 import Control.Monad (liftM)
+import Web.Utils
 
 req1 = mkRequest [("REQUEST_METHOD","GET"),
                   ("PATH_INFO", "/posts/")] ""
 alwaysSucceedView1 = const (return $ Just resp1)
 alwaysSucceedView2 = const (return $ Just resp2)
 
+viewWithStringParam1 :: String -> Request -> IO (Maybe Response)
+viewWithStringParam1 p req = return $ Just $ viewWithStringParam1' p
+viewWithStringParam1' p = buildResponse utf8HtmlResponse [
+                           addContent $ utf8 ("Got: " ++ p)
+                          ]
+
 testDispatchRequest1 = (dispatchRequest req1 [] 
                         >>= return . isNothing)
                        ~? "With no views, nothing is dispatched"
                   >>= return . isJust)
                  ~? "matchPath allows dispatching if path does match"
 
+testMatchStringParam1 = (dispatchRequest req1 [matchStringParam viewWithStringParam1]
+                         >>= return . (== Just (viewWithStringParam1' "/posts/")))
+                        ~? "matchStringParam captures string and passes to view"
+
 tests = test [
          testDispatchRequest1
         , testDispatchRequest2
         , testDispatchRequest3
         , testMatchPath1
         , testMatchPath2
+        , testMatchStringParam1
         ]