1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, ViewPatterns #-}
module YesodCoreTest.WaiSubsite
( specs
, Widget
, resourcesY
) where
import YesodCoreTest.YesodTest
import Yesod.Core
import qualified Network.HTTP.Types as H
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B (concat)
import qualified Data.ByteString.Lazy.Char8 as B8 (pack)
myApp :: ByteString -> Application
myApp s _ f = f $ responseLBS H.status200 [("Content-type", "text/plain")] s
getApp :: a -> WaiSubsite
getApp _ = WaiSubsite $ myApp "WAI"
getAppArgs :: a -> Int -> Int -> WaiSubsite
getAppArgs _ i j = WaiSubsite $ myApp $ B.concat ["WAI - ", B8.pack $ show i, " - ", B8.pack $ show j ]
data Y = Y
mkYesod "Y" [parseRoutes|
/ RootR GET
/sub WaiSubsiteR WaiSubsite getApp
/nested NestedR:
/sub NestedWaiSubsiteR WaiSubsite getApp
/nestedargs/#Int NestedArgsR:
/sub/#Int NestedArgsWaiSubsiteR WaiSubsite getAppArgs
|]
instance Yesod Y
app :: Session () -> IO ()
app = yesod Y
getRootR :: Handler ()
getRootR = return ()
specs :: Spec
specs = describe "WaiSubsite" $ do
it "root" $ app $ do
res <- request defaultRequest { pathInfo = [] }
assertStatus 200 res
assertBodyContains "" res
it "subsite" $ app $ do
res <- request defaultRequest { pathInfo = ["sub", "foo"] }
assertStatus 200 res
assertBodyContains "WAI" res
it "nested subsite" $ app $ do
res <- request defaultRequest { pathInfo = ["nested", "sub", "foo"] }
assertStatus 200 res
assertBodyContains "WAI" res
it "nested subsite with arguments" $ app $ do
res <- request defaultRequest { pathInfo = ["nestedargs", "1", "sub", "2", "foo"] }
assertStatus 200 res
assertBodyContains "WAI - 1 - 2" res
|
