{-# 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