haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

test cases for multiple method routes

Browse Source
This commit is contained in:
Greg Weber 2013-12-22 17:10:17 -08:00
parent 9b69c15bfd
commit 20efbebe4e
2 changed files with 30 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
yesod-core/test/YesodCoreTest/Redirect.hs
View File

@ -7,7 +7,7 @@ import qualified Network.HTTP.Types as H
data Y = Y data Y = Y
mkYesod "Y" [parseRoutes| mkYesod "Y" [parseRoutes|
/ RootR GET / RootR GET POST
/r301 R301 GET /r301 R301 GET
/r303 R303 GET /r303 R303 GET
/r307 R307 GET /r307 R307 GET
@ -20,6 +20,9 @@ app = yesod Y
getRootR :: Handler () getRootR :: Handler ()
getRootR = return () getRootR = return ()
postRootR :: Handler ()
postRootR = return ()
getR301, getR303, getR307, getRRegular :: Handler () getR301, getR303, getR307, getRRegular :: Handler ()
getR301 = redirectWith H.status301 RootR getR301 = redirectWith H.status301 RootR
getR303 = redirectWith H.status303 RootR getR303 = redirectWith H.status303 RootR
@ -28,6 +31,11 @@ getRRegular = redirect RootR
specs :: Spec specs :: Spec
specs = describe "Redirect" $ do specs = describe "Redirect" $ do
it "no redirect" $ app $ do
res <- request defaultRequest { pathInfo = [], requestMethod = "POST" }
assertStatus 200 res
assertBodyContains "" res
it "301 redirect" $ app $ do it "301 redirect" $ app $ do
res <- request defaultRequest { pathInfo = ["r301"] } res <- request defaultRequest { pathInfo = ["r301"] }
assertStatus 301 res assertStatus 301 res

22
yesod-routes/test/Hierarchy.hs
View File

@ -24,7 +24,7 @@ import Yesod.Routes.TH
import Yesod.Routes.Class import Yesod.Routes.Class
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import qualified Yesod.Routes.Class as YRC import qualified Yesod.Routes.Class as YRC
import Data.Text (Text, pack, append) import Data.Text (Text, pack, unpack, append)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
@ -87,6 +87,7 @@ do
/spaces SpacedR GET /spaces SpacedR GET
/nest2 Nest2: /nest2 Nest2:
/ GetPostR GET POST
/get Get2 GET /get Get2 GET
/post Post2 POST /post Post2 POST
-- /#Int Delete2 DELETE -- /#Int Delete2 DELETE
@ -152,6 +153,13 @@ postLoginR i = pack $ "post login: " ++ show i
getTableR :: Int -> Text -> Handler site Text getTableR :: Int -> Text -> Handler site Text
getTableR _ = append "TableR " getTableR _ = append "TableR "
getGetPostR :: Handler site Text
getGetPostR = pack "get"
postGetPostR :: Handler site Text
postGetPostR = pack "post"
hierarchy :: Spec hierarchy :: Spec
hierarchy = describe "hierarchy" $ do hierarchy = describe "hierarchy" $ do
it "nested with spacing" $ it "nested with spacing" $
@ -167,6 +175,18 @@ hierarchy = describe "hierarchy" $ do
, envSub = Hierarchy , envSub = Hierarchy
}) })
(map pack ps, S8.pack m) (map pack ps, S8.pack m)
let testGetPost route getRes postRes = do
let routeStrs = map unpack $ fst (renderRoute route)
disp "GET" routeStrs @?= (getRes, Just route)
disp "POST" routeStrs @?= (postRes, Just route)
it "dispatches routes with multiple METHODs: admin" $
testGetPost (AdminR 1 LoginR) "login: 1" "post login: 1"
it "dispatches routes with multiple METHODs: nesting" $
testGetPost (NestR $ Nest2 GetPostR) "get" "post"
it "dispatches root correctly" $ disp "GET" ["admin", "7"] @?= ("admin root: 7", Just $ AdminR 7 AdminRootR) it "dispatches root correctly" $ disp "GET" ["admin", "7"] @?= ("admin root: 7", Just $ AdminR 7 AdminRootR)
it "dispatches table correctly" $ disp "GET" ["admin", "8", "table", "bar"] @?= ("TableR bar", Just $ AdminR 8 $ TableR "bar") it "dispatches table correctly" $ disp "GET" ["admin", "8", "table", "bar"] @?= ("TableR bar", Just $ AdminR 8 $ TableR "bar")
it "parses" $ do it "parses" $ do