Added some Web.Mime unit tests

This commit is contained in:
Michael Snoyman 2010-02-23 18:12:53 +02:00
parent 417d09a968
commit c85a542888
7 changed files with 44 additions and 13 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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
]

View File

@ -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