Integrated tests into test suite

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
+    assertBool "/denied/" $ "Permission denied" `isInfixOf` show res
-    print $ "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
+    assertBool "/has-args/" $ "secondParam" `isInfixOf` show res3
-    print $ "secondParam" `isInfixOf` show res3
+
+testSuite :: Test
+testSuite = testGroup "Test.Errors"
+    [ testCase "errorMessages" caseErrorMessages
+    ]

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 :: [String] -> Handler MyYesod RepChooser -> Assertion
-ph h = do
+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 ()
+caseQuasi :: Assertion
-main = do
+caseQuasi = do
-    ph $ handler ["static", "foo", "bar", "baz"] Get
+    ph ["200", "foo"] $ handler ["static", "foo", "bar", "baz"] Get
-    ph $ handler ["foo", "bar", "baz"] Get
+    ph ["404"] $ handler ["foo", "bar", "baz"] Get
-    ph $ handler ["page"] Get
+    ph ["200", "pageIndex"] $ handler ["page"] Get
-    ph $ handler ["user"] Get
+    ph ["404"] $ handler ["user"] Get
-    ph $ handler ["user", "five"] Get
+    ph ["404"] $ handler ["user", "five"] Get
-    ph $ handler ["user", "5"] Get
+    ph ["200", "userInfo", "5"] $ handler ["user", "5"] Get
-    ph $ handler ["user", "5", "profile", "email"] Get
+    ph ["200", "userVar"] $ handler ["user", "5", "profile", "email"] Get
+
+testSuite :: Test
+testSuite = testGroup "Test.QuasiResource"
+    [ testCase "quasi" caseQuasi
+    ]

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

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

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 "<fooval>")
                           , ("bar", toHtmlObject ["bar1", "bar2"])
                           ]

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"

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 ++ "/"

examples/hellotemplate.lhs

@@ -20,6 +20,7 @@ helloWorld = return $ TemplateFile "examples/template.html" $ cs
                 , ("content", "Hey look!! I'm <auto escaped>!")
                 ]
 
+helloGroup :: Handler y Template
 helloGroup = template "real-template" "foo" (cs "bar") $ return []
 
 main :: IO ()

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
     ]