convert to hspec

This commit is contained in:
Greg Weber 2011-08-14 19:30:02 -07:00
parent 016d6e76f5
commit 7bece4c246
8 changed files with 54 additions and 50 deletions

View File

@ -3,14 +3,14 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Test.CleanPath (cleanPathTest) where module Test.CleanPath (cleanPathTest) where
import Test.Hspec
import Test.Hspec.HUnit
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Yesod.Content import Yesod.Content
import Yesod.Dispatch import Yesod.Dispatch
import Yesod.Handler (Route) import Yesod.Handler (Route)
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Network.Wai import Network.Wai
import Network.Wai.Test import Network.Wai.Test
import Network.HTTP.Types (status200, decodePathSegments) import Network.HTTP.Types (status200, decodePathSegments)
@ -57,15 +57,16 @@ getFooStringR = return . RepPlain . toContent
getBarR = return $ RepPlain "bar" getBarR = return $ RepPlain "bar"
getPlainR = return $ RepPlain "plain" getPlainR = return $ RepPlain "plain"
cleanPathTest :: Test cleanPathTest :: IO [IO Spec]
cleanPathTest = testGroup "Test.CleanPath" cleanPathTest =
[ testCase "remove trailing slash" removeTrailingSlash describe "Test.CleanPath"
, testCase "noTrailingSlash" noTrailingSlash [ it "remove trailing slash" removeTrailingSlash
, testCase "add trailing slash" addTrailingSlash , it "noTrailingSlash" noTrailingSlash
, testCase "has trailing slash" hasTrailingSlash , it "add trailing slash" addTrailingSlash
, testCase "/foo/something" fooSomething , it "has trailing slash" hasTrailingSlash
, testCase "subsite dispatch" subsiteDispatch , it "/foo/something" fooSomething
, testCase "redirect with query string" redQueryString , it "subsite dispatch" subsiteDispatch
, it "redirect with query string" redQueryString
] ]
runner f = toWaiApp Y >>= runSession f runner f = toWaiApp Y >>= runSession f

View File

@ -3,14 +3,14 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Test.Exceptions (exceptionsTest) where module Test.Exceptions (exceptionsTest) where
import Test.Hspec
import Test.Hspec.HUnit
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Yesod.Content import Yesod.Content
import Yesod.Dispatch import Yesod.Dispatch
import Yesod.Handler (Route, ErrorResponse (InternalError)) 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
import Network.Wai.Test import Network.Wai.Test
@ -28,9 +28,9 @@ instance Yesod Y where
getRootR = error "FOOBAR" >> return () getRootR = error "FOOBAR" >> return ()
exceptionsTest :: Test exceptionsTest :: IO [IO Spec]
exceptionsTest = testGroup "Test.Exceptions" exceptionsTest = describe "Test.Exceptions"
[ testCase "500" case500 [ it "500" case500
] ]
runner f = toWaiApp Y >>= runSession f runner f = toWaiApp Y >>= runSession f

View File

@ -3,12 +3,12 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Test.Links (linksTest) where module Test.Links (linksTest) where
import Test.Hspec
import Test.Hspec.HUnit
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Text.Hamlet import Text.Hamlet
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Network.Wai import Network.Wai
import Network.Wai.Test import Network.Wai.Test
@ -24,9 +24,9 @@ instance Yesod Y where
getRootR = defaultLayout $ addHamlet [$hamlet|<a href=@{RootR}>|] getRootR = defaultLayout $ addHamlet [$hamlet|<a href=@{RootR}>|]
linksTest :: Test linksTest :: IO [IO Spec]
linksTest = testGroup "Test.Links" linksTest = describe "Test.Links"
[ testCase "linkToHome" case_linkToHome [ it "linkToHome" case_linkToHome
] ]
runner f = toWaiApp Y >>= runSession f runner f = toWaiApp Y >>= runSession f

View File

@ -3,11 +3,11 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Test.Media (mediaTest) where module Test.Media (mediaTest) where
import Test.Hspec
import Test.Hspec.HUnit
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Network.Wai import Network.Wai
import Network.Wai.Test import Network.Wai.Test
import Network.HTTP.Types (status200, decodePathSegments) import Network.HTTP.Types (status200, decodePathSegments)
@ -58,7 +58,8 @@ caseMediaLink = runner $ do
assertStatus 200 res assertStatus 200 res
flip assertBody res "<!DOCTYPE html>\n<html><head><title></title><link rel=\"stylesheet\" href=\"all.css\"><link rel=\"stylesheet\" media=\"screen\" href=\"screen.css\"></head><body></body></html>" flip assertBody res "<!DOCTYPE html>\n<html><head><title></title><link rel=\"stylesheet\" href=\"all.css\"><link rel=\"stylesheet\" media=\"screen\" href=\"screen.css\"></head><body></body></html>"
mediaTest = testGroup "Test.Media" mediaTest :: IO [IO Spec]
[ testCase "media" caseMedia mediaTest = describe "Test.Media"
, testCase "media link" caseMediaLink [ it "media" caseMedia
, it "media link" caseMediaLink
] ]

View File

@ -2,9 +2,10 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Test.NoOverloadedStrings (noOverloadedTest) where module Test.NoOverloadedStrings (noOverloadedTest) where
import Test.Hspec
import Test.Hspec.HUnit
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit
import Network.Wai.Test import Network.Wai.Test
import Network.Wai import Network.Wai
import Data.Monoid (mempty) import Data.Monoid (mempty)
@ -44,7 +45,7 @@ case_sanity = runner $ do
res <- request defaultRequest res <- request defaultRequest
assertBody mempty res assertBody mempty res
noOverloadedTest :: Test noOverloadedTest :: IO [IO Spec]
noOverloadedTest = testGroup "Test.NoOverloadedStrings" noOverloadedTest = describe "Test.NoOverloadedStrings"
[ testCase "sanity" case_sanity [ it "sanity" case_sanity
] ]

View File

@ -3,15 +3,15 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Test.Widget (widgetTest) where module Test.Widget (widgetTest) where
import Test.Hspec
import Test.Hspec.HUnit
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Yesod.Content import Yesod.Content
import Yesod.Dispatch import Yesod.Dispatch
import Yesod.Widget import Yesod.Widget
import Text.Julius import Text.Julius
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Network.Wai import Network.Wai
import Network.Wai.Test import Network.Wai.Test
@ -54,10 +54,10 @@ getWhamletR = defaultLayout [$whamlet|
where where
embed = [$whamlet|<h4>Embed|] embed = [$whamlet|<h4>Embed|]
widgetTest :: Test widgetTest :: IO [IO Spec]
widgetTest = testGroup "Test.Widget" widgetTest = describe "Test.Widget"
[ testCase "addJuliusBody" case_addJuliusBody [ it "addJuliusBody" case_addJuliusBody
, testCase "whamlet" case_whamlet , it "whamlet" case_whamlet
] ]
runner f = toWaiApp Y >>= runSession f runner f = toWaiApp Y >>= runSession f

View File

@ -1,4 +1,5 @@
import Test.Framework (defaultMain) import Test.Hspec
import Test.CleanPath import Test.CleanPath
import Test.Exceptions import Test.Exceptions
import Test.Widget import Test.Widget
@ -7,7 +8,7 @@ import Test.Links
import Test.NoOverloadedStrings import Test.NoOverloadedStrings
main :: IO () main :: IO ()
main = defaultMain main = hspecX $ descriptions $
[ cleanPathTest [ cleanPathTest
, exceptionsTest , exceptionsTest
, widgetTest , widgetTest

View File

@ -78,6 +78,8 @@ library
test-suite runtests test-suite runtests
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: test/main.hs
if flag(ghc7) if flag(ghc7)
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
build-depends: base >= 4.3 && < 5 build-depends: base >= 4.3 && < 5
@ -88,12 +90,10 @@ test-suite runtests
build-depends: base >= 4 && < 4.3 build-depends: base >= 4 && < 4.3
main-is: runtests.hs main-is: runtests.hs
cpp-options: -DTEST cpp-options: -DTEST
build-depends: test-framework, build-depends: hspec >= 0.6 && < 0.7
test-framework-quickcheck2, ,wai-test
test-framework-hunit, ,HUnit
HUnit, ,QuickCheck >= 2 && < 3
wai-test,
QuickCheck >= 2 && < 3
ghc-options: -Wall ghc-options: -Wall
main-is: runtests.hs main-is: runtests.hs