Added some Web.Mime unit tests
This commit is contained in:
parent
417d09a968
commit
c85a542888
33
Web/Mime.hs
33
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
|
||||
|
||||
3
Yesod.hs
3
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user