From c85a542888e0de1b03ca383a4177208bd9abebff Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 23 Feb 2010 18:12:53 +0200 Subject: [PATCH] Added some Web.Mime unit tests --- Web/Mime.hs | 33 +++++++++++++++++++++++++++++++++ Yesod.hs | 3 ++- Yesod/Resource.hs | 4 +--- Yesod/Response.hs | 4 ++-- Yesod/Yesod.hs | 4 +--- runtests.hs | 2 ++ yesod.cabal | 7 +++---- 7 files changed, 44 insertions(+), 13 deletions(-) diff --git a/Web/Mime.hs b/Web/Mime.hs index 2e915d4e..deef197d 100644 --- a/Web/Mime.hs +++ b/Web/Mime.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} -- | Generic MIME type module. Could be spun off into its own package. module Web.Mime ( ContentType (..) @@ -7,12 +8,24 @@ module Web.Mime , typeByExt , ext , simpleContentType +#if TEST + , testSuite +#endif ) where import Data.Function (on) import Data.Convertible.Text import Data.ByteString.Char8 (pack, ByteString, unpack) +#if TEST +import Test.Framework (testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit hiding (Test) +import Test.QuickCheck +import Control.Monad (when) +#endif + data ContentType = TypeHtml | TypePlain @@ -75,3 +88,23 @@ typeByExt _ = TypeOctet -- | Get a file extension (everything after last period). ext :: String -> String ext = reverse . fst . break (== '.') . reverse + +#if TEST +---- Testing +testSuite :: Test +testSuite = testGroup "Yesod.Resource" + [ testProperty "ext" propExt + , testCase "typeByExt" caseTypeByExt + ] + +propExt :: String -> Bool +propExt s = + let s' = filter (/= '.') s + in s' == ext ("foobarbaz." ++ s') + +caseTypeByExt :: Assertion +caseTypeByExt = do + TypeJavascript @=? typeByExt (ext "foo.js") + TypeHtml @=? typeByExt (ext "foo.html") + +#endif diff --git a/Yesod.hs b/Yesod.hs index c95392d5..af6f8dbe 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -32,11 +32,13 @@ import Yesod.Resource hiding (testSuite) import Yesod.Response hiding (testSuite) import Data.Object.Html hiding (testSuite) import Yesod.Request hiding (testSuite) +import Web.Mime hiding (testSuite) #else import Yesod.Resource import Yesod.Response import Data.Object.Html import Yesod.Request +import Web.Mime #endif import Yesod.Form @@ -45,4 +47,3 @@ import Yesod.Definitions import Yesod.Handler import Network.Wai (Application) import Yesod.Template -import Web.Mime diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs index 45d220bf..8de66af1 100644 --- a/Yesod/Resource.hs +++ b/Yesod/Resource.hs @@ -60,7 +60,7 @@ import Data.ByteString (ByteString) import Control.Monad (replicateM) import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck (testProperty) +import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit hiding (Test) import Test.QuickCheck import Control.Monad (when) @@ -414,7 +414,6 @@ testSuite = testGroup "Yesod.Resource" ] instance Arbitrary RP where - coarbitrary = undefined arbitrary = do size <- elements [1..10] rpps <- replicateM size arbitrary @@ -486,7 +485,6 @@ instance Arbitrary RPP where size <- elements [1..10] s <- replicateM size $ elements ['a'..'z'] return $ constr s - coarbitrary = undefined caseFromYaml :: Assertion caseFromYaml = do diff --git a/Yesod/Response.hs b/Yesod/Response.hs index 219fec73..3c1944d6 100644 --- a/Yesod/Response.hs +++ b/Yesod/Response.hs @@ -69,17 +69,17 @@ import qualified Network.Wai.Enumerator as WE #if TEST import Yesod.Request hiding (testSuite) import Data.Object.Html hiding (testSuite) +import Web.Mime hiding (testSuite) #else import Yesod.Request import Data.Object.Html +import Web.Mime #endif #if TEST import Test.Framework (testGroup, Test) #endif -import Web.Mime - data Content = ContentFile FilePath | ContentEnum (forall a. W.Enumerator a) diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index b34572d2..2e69d312 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -23,7 +23,6 @@ import Web.Encodings (parseHttpAccept) import qualified Network.Wai as W import Network.Wai.Middleware.CleanPath import Network.Wai.Middleware.ClientSession -import Network.Wai.Middleware.Gzip import Network.Wai.Middleware.Jsonp import Network.Wai.Middleware.MethodOverride @@ -110,8 +109,7 @@ toWaiApp :: Yesod y => y -> IO W.Application toWaiApp a = do key <- encryptKey a let mins = clientSessionDuration a - return $ gzip - $ jsonp + return $ jsonp $ methodOverride $ cleanPath $ \thePath -> clientsession encryptedCookies key mins diff --git a/runtests.hs b/runtests.hs index 5abb4cbe..91a0a81b 100644 --- a/runtests.hs +++ b/runtests.hs @@ -6,6 +6,7 @@ import qualified Yesod.Request import qualified Data.Object.Html import qualified Test.Errors import qualified Test.QuasiResource +import qualified Web.Mime main :: IO () main = defaultMain @@ -15,4 +16,5 @@ main = defaultMain , Data.Object.Html.testSuite , Test.Errors.testSuite , Test.QuasiResource.testSuite + , Web.Mime.testSuite ] diff --git a/yesod.cabal b/yesod.cabal index abfc3d6f..58f200d8 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -46,7 +46,7 @@ library control-monad-attempt >= 0.0.0 && < 0.1, syb, text >= 0.5 && < 0.8, - convertible-text >= 0.2.0 && < 0.3, + convertible-text >= 0.2.0.5 && < 0.3, HStringTemplate >= 0.6.2 && < 0.7, data-object-json >= 0.0.0 && < 0.1, attempt >= 0.2.1 && < 0.3, @@ -75,11 +75,10 @@ executable runtests Buildable: True cpp-options: -DTEST build-depends: test-framework, - test-framework-quickcheck, + test-framework-quickcheck2, test-framework-hunit, HUnit, - QuickCheck >= 1 && < 2, - data-default >= 0.2 && < 0.3 + QuickCheck >= 2 && < 3 else Buildable: False ghc-options: -Wall