diff --git a/Test/CleanPath.hs b/Test/CleanPath.hs index a3161321..85e87931 100644 --- a/Test/CleanPath.hs +++ b/Test/CleanPath.hs @@ -1,10 +1,12 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} module Test.CleanPath (cleanPathTest) where import Yesod.Core import Yesod.Content import Yesod.Dispatch +import Yesod.Handler (Route) import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit @@ -12,11 +14,28 @@ import Test.HUnit hiding (Test) import Network.Wai import Network.Wai.Test +import qualified Data.ByteString.Lazy.Char8 as L8 + +data Subsite = Subsite +getSubsite = const Subsite +data SubsiteRoute = SubsiteRoute [String] + deriving (Eq, Show, Read) +type instance Route Subsite = SubsiteRoute +instance RenderRoute SubsiteRoute where + renderRoute (SubsiteRoute x) = (x, []) + +instance YesodDispatch Subsite master where + yesodDispatch _ _ pieces _ _ = Just $ const $ return $ responseLBS + status200 + [ ("Content-Type", "SUBSITE") + ] $ L8.pack $ show pieces + data Y = Y mkYesod "Y" [$parseRoutes| /foo FooR GET /foo/#String FooStringR GET /bar BarR GET +/subsite SubsiteR Subsite getSubsite |] instance Yesod Y where @@ -41,6 +60,7 @@ cleanPathTest = testGroup "Test.CleanPath" , testCase "add trailing slash" addTrailingSlash , testCase "has trailing slash" hasTrailingSlash , testCase "/foo/something" fooSomething + , testCase "subsite dispatch" subsiteDispatch ] runner f = toWaiApp Y >>= runSession f @@ -88,3 +108,11 @@ fooSomething = runner $ do assertStatus 200 res assertContentType "text/plain; charset=utf-8" res assertBody "something" res + +subsiteDispatch = runner $ do + res <- request defaultRequest + { pathInfo = "/subsite/1/2/3/" + } + assertStatus 200 res + assertContentType "SUBSITE" res + assertBody "[\"1\",\"2\",\"3\",\"\"]" res