diff --git a/test/errors.hs b/Test/Errors.hs similarity index 54% rename from test/errors.hs rename to Test/Errors.hs index b841f1ba..f4d142d3 100644 --- a/test/errors.hs +++ b/Test/Errors.hs @@ -1,8 +1,14 @@ {-# LANGUAGE QuasiQuotes #-} +module Test.Errors (testSuite) where + import Yesod +import Yesod.Helpers.Auth import Hack import Data.Default import Data.List +import Test.Framework (testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) data Errors = Errors instance Yesod Errors where @@ -14,13 +20,16 @@ instance Yesod Errors where /has-args: Get: hasArgs |] +instance YesodApproot Errors where + approot _ = Approot "IGNORED/" +instance YesodAuth Errors denied :: Handler Errors () denied = permissionDenied needsIdent :: Handler Errors HtmlObject needsIdent = do - i <- identifier + i <- authIdentifier return $ toHtmlObject i hasArgs :: Handler Errors HtmlObject @@ -30,14 +39,18 @@ hasArgs = do b <- getParam "secondParam" return $ toHtmlObject [a :: String, b] -main = do +caseErrorMessages :: Assertion +caseErrorMessages = do let app = toHackApp Errors res <- app $ def { pathInfo = "/denied/" } - print res - print $ "Permission denied" `isInfixOf` show res + assertBool "/denied/" $ "Permission denied" `isInfixOf` show res res' <- app $ def { pathInfo = "/needs-ident/" } print res' - print $ "Permission denied" `isInfixOf` show res' + assertBool "/needs-ident/" $ "IGNORED/auth/openid/" `isInfixOf` show res' res3 <- app $ def { pathInfo = "/has-args/" } - print res3 - print $ "secondParam" `isInfixOf` show res3 + assertBool "/has-args/" $ "secondParam" `isInfixOf` show res3 + +testSuite :: Test +testSuite = testGroup "Test.Errors" + [ testCase "errorMessages" caseErrorMessages + ] diff --git a/test/quasi-resource.hs b/Test/QuasiResource.hs similarity index 68% rename from test/quasi-resource.hs rename to Test/QuasiResource.hs index 03c0b88c..0e610c98 100644 --- a/test/quasi-resource.hs +++ b/Test/QuasiResource.hs @@ -1,8 +1,14 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE QuasiQuotes #-} +module Test.QuasiResource (testSuite) where + import Yesod import Text.StringTemplate (nullGroup) +import Test.Framework (testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) +import Data.List data MyYesod = MyYesod @@ -49,21 +55,29 @@ handler = [$resources| Get: userPage |] -ph :: Handler MyYesod RepChooser -> IO () -ph h = do +ph :: [String] -> Handler MyYesod RepChooser -> Assertion +ph ss h = do let eh = return . chooseRep . toHtmlObject . show rr = error "No raw request" y = MyYesod cts = [TypeHtml] res <- runHandler h eh rr y nullGroup cts - print res + mapM_ (helper $ show res) ss + where + helper haystack needle = + assertBool needle $ needle `isInfixOf` haystack -main :: IO () -main = do - ph $ handler ["static", "foo", "bar", "baz"] Get - ph $ handler ["foo", "bar", "baz"] Get - ph $ handler ["page"] Get - ph $ handler ["user"] Get - ph $ handler ["user", "five"] Get - ph $ handler ["user", "5"] Get - ph $ handler ["user", "5", "profile", "email"] Get +caseQuasi :: Assertion +caseQuasi = do + ph ["200", "foo"] $ handler ["static", "foo", "bar", "baz"] Get + ph ["404"] $ handler ["foo", "bar", "baz"] Get + ph ["200", "pageIndex"] $ handler ["page"] Get + ph ["404"] $ handler ["user"] Get + ph ["404"] $ handler ["user", "five"] Get + ph ["200", "userInfo", "5"] $ handler ["user", "5"] Get + ph ["200", "userVar"] $ handler ["user", "5", "profile", "email"] Get + +testSuite :: Test +testSuite = testGroup "Test.QuasiResource" + [ testCase "quasi" caseQuasi + ] diff --git a/test/rep.st b/Test/rep.st similarity index 100% rename from test/rep.st rename to Test/rep.st diff --git a/test/resource-patterns.yaml b/Test/resource-patterns.yaml similarity index 100% rename from test/resource-patterns.yaml rename to Test/resource-patterns.yaml diff --git a/Yesod.hs b/Yesod.hs index 8f8fa700..c96f9d7b 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} --------------------------------------------------------- -- -- Module : Yesod @@ -26,14 +27,22 @@ module Yesod , Application ) where -import Yesod.Request +#if TEST +import Yesod.Resource hiding (testSuite) +import Yesod.Response hiding (testSuite) +import Data.Object.Html hiding (testSuite) +import Yesod.Rep hiding (testSuite) +#else +import Yesod.Resource import Yesod.Response +import Data.Object.Html +import Yesod.Rep +#endif + +import Yesod.Request import Yesod.Yesod import Yesod.Definitions import Yesod.Handler -import Yesod.Resource import Hack (Application) -import Yesod.Rep import Yesod.Template -import Data.Object.Html import Data.Convertible.Text diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index a2f7b13e..3f7831a7 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -176,7 +176,6 @@ authIdentifier = do Nothing -> do rp <- requestPath let dest = ar ++ rp - liftIO $ print ("authIdentifier", dest, ar, rp) lp <- defaultLoginPath `fmap` getYesod addCookie 120 "DEST" dest redirect $ ar ++ lp diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs index 1b95523d..54bcc786 100644 --- a/Yesod/Rep.hs +++ b/Yesod/Rep.hs @@ -250,7 +250,7 @@ caseChooseRepTemplate = do caseChooseRepTemplateFile :: Assertion caseChooseRepTemplateFile = do - let temp = "test/rep.st" + let temp = "Test/rep.st" ho = toHtmlObject [ ("foo", toHtmlObject "") , ("bar", toHtmlObject ["bar1", "bar2"]) ] diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs index 81a5cf31..6a77c233 100644 --- a/Yesod/Resource.hs +++ b/Yesod/Resource.hs @@ -479,7 +479,7 @@ instance Arbitrary RPP where caseFromYaml :: Assertion caseFromYaml = do - contents <- readYamlDoc "test/resource-patterns.yaml" + contents <- readYamlDoc "Test/resource-patterns.yaml" rp1 <- readRP "static/*filepath" rp2 <- readRP "page" rp3 <- readRP "page/$page" @@ -498,7 +498,7 @@ caseFromYaml = do caseCheckRPNodes :: Assertion caseCheckRPNodes = do - good' <- readYamlDoc "test/resource-patterns.yaml" + good' <- readYamlDoc "Test/resource-patterns.yaml" good <- fa $ ca good' Just good @=? checkRPNodes good rp1 <- readRP "foo/bar" diff --git a/examples/fact.lhs b/examples/fact.lhs index 70e74c4f..49a6f867 100644 --- a/examples/fact.lhs +++ b/examples/fact.lhs @@ -87,6 +87,7 @@ I've decided to have a redirect instead of serving the some data in two locations. It fits in more properly with the RESTful principal of one name for one piece of data. +> factRedirect :: Handler y () > factRedirect = do > i <- getParam "num" > redirect $ "../" ++ i ++ "/" diff --git a/examples/hellotemplate.lhs b/examples/hellotemplate.lhs index 69aa4a87..6bb06cb3 100644 --- a/examples/hellotemplate.lhs +++ b/examples/hellotemplate.lhs @@ -20,6 +20,7 @@ helloWorld = return $ TemplateFile "examples/template.html" $ cs , ("content", "Hey look!! I'm !") ] +helloGroup :: Handler y Template helloGroup = template "real-template" "foo" (cs "bar") $ return [] main :: IO () diff --git a/runtests.hs b/runtests.hs index e4a7eaca..b7b64c3e 100644 --- a/runtests.hs +++ b/runtests.hs @@ -5,6 +5,8 @@ import qualified Yesod.Utils import qualified Yesod.Resource import qualified Yesod.Rep import qualified Data.Object.Html +import qualified Test.Errors +import qualified Test.QuasiResource main :: IO () main = defaultMain @@ -13,4 +15,6 @@ main = defaultMain , Yesod.Resource.testSuite , Yesod.Rep.testSuite , Data.Object.Html.testSuite + , Test.Errors.testSuite + , Test.QuasiResource.testSuite ]