diff --git a/Test/Exceptions.hs b/Test/Exceptions.hs new file mode 100644 index 00000000..fb869f10 --- /dev/null +++ b/Test/Exceptions.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +module Test.Exceptions (exceptionsTest) where + +import Yesod.Core +import Yesod.Content +import Yesod.Dispatch +import Yesod.Handler (Route, ErrorResponse (InternalError)) + +import Test.Framework (defaultMain, testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) +import Network.Wai +import Network.Wai.Test + +import qualified Data.ByteString.Lazy.Char8 as L8 + +data Y = Y +mkYesod "Y" [$parseRoutes| +/ RootR GET +|] + +instance Yesod Y where + approot _ = "http://test" + errorHandler (InternalError e) = return $ chooseRep $ RepPlain $ toContent e + errorHandler x = defaultErrorHandler x + +getRootR = error "FOOBAR" >> return () + +exceptionsTest :: Test +exceptionsTest = testGroup "Test.Exceptions" + [ testCase "500" case500 + ] + +runner f = toWaiApp Y >>= runSession f +defaultRequest = Request + { pathInfo = "" + , requestHeaders = [] + , queryString = "" + , requestMethod = "GET" + } + +case500 = runner $ do + res <- request defaultRequest + assertStatus 500 res + assertBody "FOOBAR" res diff --git a/runtests.hs b/runtests.hs index c2fc7d9d..d4d2c34b 100644 --- a/runtests.hs +++ b/runtests.hs @@ -1,7 +1,9 @@ import Test.Framework (defaultMain) import Test.CleanPath +import Test.Exceptions main :: IO () main = defaultMain [ cleanPathTest + , exceptionsTest ]