yesod-core 0.9.3.3 → 0.9.3.4
raw patch · 22 files changed
+715/−715 lines, 22 filesdep +aesondep −aeson-nativedep ~blaze-builderdep ~case-insensitivedep ~cereal
Dependencies added: aeson
Dependencies removed: aeson-native
Dependency ranges changed: blaze-builder, case-insensitive, cereal, enumerator, text, time, transformers, wai-test
Files
- Yesod/Dispatch.hs +6/−5
- Yesod/Internal/Core.hs +19/−12
- Yesod/Internal/RouteParsing.hs +17/−11
- test.hs +4/−0
- test/Test/CleanPath.hs +0/−139
- test/Test/ErrorHandling.hs +0/−111
- test/Test/Exceptions.hs +0/−37
- test/Test/InternalRequest.hs +0/−91
- test/Test/Links.hs +0/−35
- test/Test/Media.hs +0/−59
- test/Test/NoOverloadedStrings.hs +0/−52
- test/Test/Widget.hs +0/−92
- test/YesodCoreTest/CleanPath.hs +139/−0
- test/YesodCoreTest/ErrorHandling.hs +111/−0
- test/YesodCoreTest/Exceptions.hs +37/−0
- test/YesodCoreTest/InternalRequest.hs +91/−0
- test/YesodCoreTest/Links.hs +35/−0
- test/YesodCoreTest/Media.hs +59/−0
- test/YesodCoreTest/NoOverloadedStrings.hs +52/−0
- test/YesodCoreTest/Widget.hs +92/−0
- test/main.hs +0/−22
- yesod-core.cabal +53/−49
Yesod/Dispatch.hs view
@@ -4,7 +4,9 @@ module Yesod.Dispatch ( -- * Quasi-quoted routing parseRoutes+ , parseRoutesNoCheck , parseRoutesFile+ , parseRoutesFileNoCheck , mkYesod , mkYesodSub -- ** More fine-grained@@ -30,11 +32,10 @@ import Yesod.Widget (GWidget) import Web.PathPieces (SinglePiece (..), MultiPiece (..))-import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesFile)+import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesNoCheck, parseRoutesFile, parseRoutesFileNoCheck) import Language.Haskell.TH.Syntax import qualified Network.Wai as W-import Network.Wai.Middleware.Jsonp import Network.Wai.Middleware.Gzip import Network.Wai.Middleware.Autohead @@ -172,11 +173,11 @@ error $ "Invalid attributes for resource: " ++ n -- | Convert the given argument into a WAI application, executable with any WAI--- handler. This is the same as 'toWaiAppPlain', except it includes three--- middlewares: GZIP compression, JSON-P and autohead. This is the+-- handler. This is the same as 'toWaiAppPlain', except it includes two+-- middlewares: GZIP compression and autohead. This is the -- recommended approach for most users. toWaiApp :: (Yesod y, YesodDispatch y y) => y -> IO W.Application-toWaiApp y = gzip (gzipCompressFiles y) . jsonp . autohead <$> toWaiAppPlain y+toWaiApp y = gzip (gzipCompressFiles y) . autohead <$> toWaiAppPlain y -- | Convert the given argument into a WAI application, executable with any WAI -- handler. This differs from 'toWaiApp' in that it uses no middlewares.
Yesod/Internal/Core.hs view
@@ -35,8 +35,6 @@ import Control.Arrow ((***)) import Control.Monad (forM)-import qualified Paths_yesod_core-import Data.Version (showVersion) import Yesod.Widget import Yesod.Request import qualified Network.Wai as W@@ -78,6 +76,17 @@ import Data.Aeson.Encode (encode) import qualified Data.Vector as Vector +-- mega repo can't access this+#ifndef MEGA+import qualified Paths_yesod_core+import Data.Version (showVersion)+yesodVersion :: String+yesodVersion = showVersion Paths_yesod_core.version+#else+yesodVersion :: String+yesodVersion = "0.9.3.2"+#endif+ #if GHC7 #define HAMLET hamlet #else@@ -334,12 +343,12 @@ [] -> Nothing (x, _):_ -> Just x defaultYesodRunner s master toMasterRoute mkey murl handler req = do- now <- liftIO getCurrentTime- let getExpires m = fromIntegral (m * 60) `addUTCTime` now- let exp' = getExpires $ clientSessionDuration master- let rh = takeWhile (/= ':') $ show $ W.remoteHost req+ now <- {-# SCC "getCurrentTime" #-} liftIO getCurrentTime+ let getExpires m = {-# SCC "getExpires" #-} fromIntegral (m * 60) `addUTCTime` now+ let exp' = {-# SCC "exp'" #-} getExpires $ clientSessionDuration master+ let rh = {-# SCC "rh" #-} takeWhile (/= ':') $ show $ W.remoteHost req let host = if sessionIpAddress master then S8.pack rh else ""- let session' =+ let session' = {-# SCC "session'" #-} case mkey of Nothing -> [] Just key -> fromMaybe [] $ do@@ -347,7 +356,7 @@ val <- lookup sessionName $ parseCookies raw decodeSession key now host val rr <- liftIO $ parseWaiRequest req session' mkey- let h = do+ let h = {-# SCC "h" #-} do case murl of Nothing -> handler Just url -> do@@ -368,7 +377,8 @@ $ filter (\(x, _) -> x /= nonceKey) session' yar <- handlerToYAR master s toMasterRoute (yesodRender master) errorHandler rr murl sessionMap h let mnonce = reqNonce rr- iv <- liftIO CS.randomIV+ -- FIXME should we be caching this IV value and reusing it for efficiency?+ iv <- {-# SCC "iv" #-} maybe (return $ error "Should not be used") (const $ liftIO CS.randomIV) mkey return $ yarToResponse (hr iv mnonce getExpires host exp') yar where hr iv mnonce getExpires host exp' hs ct sm =@@ -595,9 +605,6 @@ case jscript of Nothing -> Nothing Just j -> Just $ jelper j--yesodVersion :: String-yesodVersion = showVersion Paths_yesod_core.version yesodRender :: Yesod y => y
Yesod/Internal/RouteParsing.hs view
@@ -331,18 +331,24 @@ pieceFromString ('*':x) = MultiPiece x pieceFromString x = StaticPiece x +-- n^2, should be a way to speed it up findOverlaps :: [Resource] -> [(Resource, Resource)]-findOverlaps = gos . map justPieces+findOverlaps = go . map justPieces where+ justPieces :: Resource -> ([Piece], Resource) justPieces r@(Resource _ ps _) = (ps, r)- gos [] = []- gos (x:xs) = mapMaybe (go x) xs ++ gos xs- go (StaticPiece x:xs, xr) (StaticPiece y:ys, yr)- | x == y = go (xs, xr) (ys, yr)++ go [] = []+ go (x:xs) = mapMaybe (mOverlap x) xs ++ go xs++ mOverlap :: ([Piece], Resource) -> ([Piece], Resource) ->+ Maybe (Resource, Resource)+ mOverlap (StaticPiece x:xs, xr) (StaticPiece y:ys, yr)+ | x == y = mOverlap (xs, xr) (ys, yr) | otherwise = Nothing- go (MultiPiece _:_, xr) (_, yr) = Just (xr, yr)- go (_, xr) (MultiPiece _:_, yr) = Just (xr, yr)- go ([], xr) ([], yr) = Just (xr, yr)- go ([], _) (_, _) = Nothing- go (_, _) ([], _) = Nothing- go (_:xs, xr) (_:ys, yr) = go (xs, xr) (ys, yr)+ mOverlap (MultiPiece _:_, xr) (_, yr) = Just (xr, yr)+ mOverlap (_, xr) (MultiPiece _:_, yr) = Just (xr, yr)+ mOverlap ([], xr) ([], yr) = Just (xr, yr)+ mOverlap ([], _) (_, _) = Nothing+ mOverlap (_, _) ([], _) = Nothing+ mOverlap (_:xs, xr) (_:ys, yr) = mOverlap (xs, xr) (ys, yr)
+ test.hs view
@@ -0,0 +1,4 @@+import Test.Hspec+import qualified YesodCoreTest++main = hspecX $ descriptions $ YesodCoreTest.specs
− test/Test/CleanPath.hs
@@ -1,139 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.CleanPath (cleanPathTest, Widget) where--import Test.Hspec-import Test.Hspec.HUnit()--import Yesod.Core hiding (Request)--import Network.Wai-import Network.Wai.Test-import Network.HTTP.Types (status200, decodePathSegments)--import qualified Data.ByteString.Lazy.Char8 as L8-import qualified Data.Text as TS--data Subsite = Subsite--getSubsite :: a -> Subsite-getSubsite = const Subsite--data SubsiteRoute = SubsiteRoute [TS.Text]- deriving (Eq, Show, Read)-type instance Route Subsite = SubsiteRoute-instance RenderRoute SubsiteRoute where- renderRoute (SubsiteRoute x) = (x, [])--instance YesodDispatch Subsite master where- yesodDispatch _ _ pieces _ _ = Just $ const $ return $ responseLBS- status200- [ ("Content-Type", "SUBSITE")- ] $ L8.pack $ show pieces--data Y = Y-mkYesod "Y" [parseRoutes|-/foo FooR GET-/foo/#String FooStringR GET-/bar BarR GET-/subsite SubsiteR Subsite getSubsite-/plain PlainR GET-|]--instance Yesod Y where- approot _ = "http://test"- cleanPath _ ["bar", ""] = Right ["bar"]- cleanPath _ ["bar"] = Left ["bar", ""]- cleanPath _ s =- if corrected == s- then Right s- else Left corrected- where- corrected = filter (not . TS.null) s--getFooR :: Handler RepPlain-getFooR = return $ RepPlain "foo"--getFooStringR :: String -> Handler RepPlain-getFooStringR = return . RepPlain . toContent--getBarR, getPlainR :: Handler RepPlain-getBarR = return $ RepPlain "bar"-getPlainR = return $ RepPlain "plain"--cleanPathTest :: [Spec]-cleanPathTest =- describe "Test.CleanPath"- [ it "remove trailing slash" removeTrailingSlash- , it "noTrailingSlash" noTrailingSlash- , it "add trailing slash" addTrailingSlash- , it "has trailing slash" hasTrailingSlash- , it "/foo/something" fooSomething- , it "subsite dispatch" subsiteDispatch- , it "redirect with query string" redQueryString- ]--runner :: Session () -> IO ()-runner f = toWaiApp Y >>= runSession f--removeTrailingSlash :: IO ()-removeTrailingSlash = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/foo/"- }- assertStatus 301 res- assertHeader "Location" "http://test/foo" res--noTrailingSlash :: IO ()-noTrailingSlash = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/foo"- }- assertStatus 200 res- assertContentType "text/plain; charset=utf-8" res- assertBody "foo" res--addTrailingSlash :: IO ()-addTrailingSlash = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/bar"- }- assertStatus 301 res- assertHeader "Location" "http://test/bar/" res--hasTrailingSlash :: IO ()-hasTrailingSlash = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/bar/"- }- assertStatus 200 res- assertContentType "text/plain; charset=utf-8" res- assertBody "bar" res--fooSomething :: IO ()-fooSomething = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/foo/something"- }- assertStatus 200 res- assertContentType "text/plain; charset=utf-8" res- assertBody "something" res--subsiteDispatch :: IO ()-subsiteDispatch = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/subsite/1/2/3/"- }- assertStatus 200 res- assertContentType "SUBSITE" res- assertBody "[\"1\",\"2\",\"3\",\"\"]" res--redQueryString :: IO ()-redQueryString = runner $ do- res <- request defaultRequest- { pathInfo = decodePathSegments "/plain/"- , rawQueryString = "?foo=bar"- }- assertStatus 301 res- assertHeader "Location" "http://test/plain?foo=bar" res
− test/Test/ErrorHandling.hs
@@ -1,111 +0,0 @@-{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}-module Test.ErrorHandling- ( errorHandlingTest- , Widget- ) where-import Yesod.Core-import Test.Hspec-import Test.Hspec.HUnit()-import Network.Wai-import Network.Wai.Test-import Text.Hamlet (hamlet)-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Char8 as S8-import Yesod.Internal.TestApi-import qualified Data.Enumerator as E-import qualified Data.Enumerator.List as EL-import Control.Exception (SomeException)--data App = App--mkYesod "App" [parseRoutes|-/ HomeR GET-/not_found NotFoundR POST-/first_thing FirstThingR POST-/after_runRequestBody AfterRunRequestBodyR POST-|]--instance Yesod App where approot _ = ""--getHomeR :: Handler RepHtml-getHomeR = defaultLayout $ toWidget [hamlet|-!!!--<html>- <body>- <form method=post action=@{NotFoundR}>- <input type=submit value="Not found">- <form method=post action=@{FirstThingR}>- <input type=submit value="Error is thrown first thing in handler">- <form method=post action=@{AfterRunRequestBodyR}>- <input type=submit value="BUGGY: Error thrown after runRequestBody">-|]--postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml-postNotFoundR = do- (_, _files) <- runRequestBody- _ <- notFound- getHomeR--postFirstThingR = do- _ <- error "There was an error 3.14159"- getHomeR--postAfterRunRequestBodyR = do- x <- runRequestBody- _ <- error $ show x- getHomeR--errorHandlingTest :: [Spec]-errorHandlingTest = describe "Test.ErrorHandling"- [ it "says not found" caseNotFound- , it "says 'There was an error' before runRequestBody" caseBefore- , it "says 'There was an error' after runRequestBody" caseAfter- , it "catchIter handles internal exceptions" caseCatchIter- ]--runner :: Session () -> IO ()-runner f = toWaiApp App >>= runSession f--caseNotFound :: IO ()-caseNotFound = runner $ do- res <- request defaultRequest- { pathInfo = ["not_found"]- , requestMethod = "POST"- }- assertStatus 404 res- assertBodyContains "Not Found" res--caseBefore :: IO ()-caseBefore = runner $ do- res <- request defaultRequest- { pathInfo = ["first_thing"]- , requestMethod = "POST"- }- assertStatus 500 res- assertBodyContains "There was an error 3.14159" res--caseAfter :: IO ()-caseAfter = runner $ do- let content = "foo=bar&baz=bin12345"- res <- srequest SRequest- { simpleRequest = defaultRequest- { pathInfo = ["after_runRequestBody"]- , requestMethod = "POST"- , requestHeaders =- [ ("content-type", "application/x-www-form-urlencoded")- , ("content-length", S8.pack $ show $ L.length content)- ]- }- , simpleRequestBody = content- }- assertStatus 500 res- assertBodyContains "bin12345" res--caseCatchIter :: IO ()-caseCatchIter = E.run_ $ E.enumList 8 (replicate 1000 "foo") E.$$ flip catchIter ignorer $ do- _ <- EL.consume- error "foo"- where- ignorer :: SomeException -> E.Iteratee a IO ()- ignorer _ = return ()
− test/Test/Exceptions.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.Exceptions (exceptionsTest, Widget) where--import Test.Hspec-import Test.Hspec.HUnit ()--import Yesod.Core hiding (Request)-import Network.Wai.Test--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 :: Handler ()-getRootR = error "FOOBAR" >> return ()--exceptionsTest :: [Spec]-exceptionsTest = describe "Test.Exceptions"- [ it "500" case500- ]--runner :: Session () -> IO ()-runner f = toWaiApp Y >>= runSession f--case500 :: IO ()-case500 = runner $ do- res <- request defaultRequest- assertStatus 500 res- assertBody "FOOBAR" res
− test/Test/InternalRequest.hs
@@ -1,91 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Test.InternalRequest (internalRequestTest) where--import Data.List (nub)-import System.Random (StdGen, mkStdGen)--import Network.Wai as W-import Network.Wai.Test-import Yesod.Internal.TestApi (randomString, parseWaiRequest')-import Yesod.Request (Request (..))-import Test.Hspec--randomStringSpecs :: [Spec]-randomStringSpecs = describe "Yesod.Internal.Request.randomString"- [ it "looks reasonably random" looksRandom- , it "does not repeat itself" $ noRepeat 10 100- ]---- NOTE: this testcase may break on other systems/architectures if--- mkStdGen is not identical everywhere (is it?).-looksRandom = randomString 20 (mkStdGen 0) == "VH9SkhtptqPs6GqtofVg"--noRepeat len n = length (nub $ map (randomString len . mkStdGen) [1..n]) == n----- For convenience instead of "(undefined :: StdGen)".-g :: StdGen-g = undefined---nonceSpecs :: [Spec]-nonceSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqNonce)"- [ it "is Nothing if sessions are disabled" noDisabledNonce- , it "ignores pre-existing nonce if sessions are disabled" ignoreDisabledNonce- , it "uses preexisting nonce in session" useOldNonce- , it "generates a new nonce for sessions without nonce" generateNonce- ]--noDisabledNonce = reqNonce r == Nothing where- r = parseWaiRequest' defaultRequest [] Nothing g--ignoreDisabledNonce = reqNonce r == Nothing where- r = parseWaiRequest' defaultRequest [("_NONCE", "old")] Nothing g--useOldNonce = reqNonce r == Just "old" where- r = parseWaiRequest' defaultRequest [("_NONCE", "old")] (Just undefined) g--generateNonce = reqNonce r /= Nothing where- r = parseWaiRequest' defaultRequest [("_NONCE", "old")] (Just undefined) g---langSpecs :: [Spec]-langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)"- [ it "respects Accept-Language" respectAcceptLangs- , it "respects sessions" respectSessionLang- , it "respects cookies" respectCookieLang- , it "respects queries" respectQueryLang- , it "prioritizes correctly" prioritizeLangs- ]--respectAcceptLangs = reqLangs r == ["accept1", "accept2"] where- r = parseWaiRequest' defaultRequest- { requestHeaders = [("Accept-Language", "accept1, accept2")] } [] Nothing g--respectSessionLang = reqLangs r == ["session"] where- r = parseWaiRequest' defaultRequest [("_LANG", "session")] Nothing g--respectCookieLang = reqLangs r == ["cookie"] where- r = parseWaiRequest' defaultRequest- { requestHeaders = [("Cookie", "_LANG=cookie")]- } [] Nothing g--respectQueryLang = reqLangs r == ["query"] where- r = parseWaiRequest' defaultRequest { queryString = [("_LANG", Just "query")] } [] Nothing g--prioritizeLangs = reqLangs r == ["query", "cookie", "session", "accept1", "accept2"] where- r = parseWaiRequest' defaultRequest- { requestHeaders = [ ("Accept-Language", "accept1, accept2")- , ("Cookie", "_LANG=cookie")- ]- , queryString = [("_LANG", Just "query")]- } [("_LANG", "session")] Nothing g---internalRequestTest :: [Spec]-internalRequestTest = descriptions [ randomStringSpecs- , nonceSpecs- , langSpecs- ]--main = hspec internalRequestTest
− test/Test/Links.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.Links (linksTest, Widget) where--import Test.Hspec-import Test.Hspec.HUnit ()--import Yesod.Core hiding (Request)-import Text.Hamlet-import Network.Wai.Test--data Y = Y-mkYesod "Y" [parseRoutes|-/ RootR GET-|]--instance Yesod Y where- approot _ = ""--getRootR :: Handler RepHtml-getRootR = defaultLayout $ addHamlet [hamlet|<a href=@{RootR}>|]--linksTest :: [Spec]-linksTest = describe "Test.Links"- [ it "linkToHome" case_linkToHome- ]--runner :: Session () -> IO ()-runner f = toWaiApp Y >>= runSession f--case_linkToHome :: IO ()-case_linkToHome = runner $ do- res <- request defaultRequest- assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a></body></html>" res
− test/Test/Media.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.Media (mediaTest, Widget) where--import Test.Hspec-import Test.Hspec.HUnit ()-import Yesod.Core hiding (Request)-import Network.Wai-import Network.Wai.Test-import Text.Lucius--data Y = Y-mkYesod "Y" [parseRoutes|-/ RootR GET-/static StaticR GET-|]--instance Yesod Y where- approot _ = ""- addStaticContent _ _ content = do- tm <- getRouteToMaster- route <- getCurrentRoute- case fmap tm route of- Just StaticR -> return $ Just $ Left $- if content == "foo2{bar:baz}"- then "screen.css"- else "all.css"- _ -> return Nothing--getRootR :: Handler RepHtml-getRootR = defaultLayout $ do- addCassius [lucius|foo1{bar:baz}|]- addCassiusMedia "screen" [lucius|foo2{bar:baz}|]- addCassius [lucius|foo3{bar:baz}|]--getStaticR :: Handler RepHtml-getStaticR = getRootR--runner :: Session () -> IO ()-runner f = toWaiApp Y >>= runSession f--caseMedia :: IO ()-caseMedia = runner $ do- res <- request defaultRequest- assertStatus 200 res- flip assertBody res "<!DOCTYPE html>\n<html><head><title></title><style>foo1{bar:baz}foo3{bar:baz}</style><style media=\"screen\">foo2{bar:baz}</style></head><body></body></html>"--caseMediaLink :: IO ()-caseMediaLink = runner $ do- res <- request defaultRequest { pathInfo = ["static"] }- 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>"--mediaTest :: [Spec]-mediaTest = describe "Test.Media"- [ it "media" caseMedia- , it "media link" caseMediaLink- ]
− test/Test/NoOverloadedStrings.hs
@@ -1,52 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.NoOverloadedStrings (noOverloadedTest, Widget) where--import Test.Hspec-import Test.Hspec.HUnit ()--import Yesod.Core hiding (Request)-import Network.Wai.Test-import Data.Monoid (mempty)-import Data.String (fromString)--data Subsite = Subsite--getSubsite :: a -> Subsite-getSubsite = const Subsite--mkYesodSub "Subsite" [] [parseRoutes|-/bar BarR GET-|]--getBarR :: GHandler Subsite m ()-getBarR = return ()--data Y = Y-mkYesod "Y" [parseRoutes|-/ RootR GET-/foo FooR GET-/subsite SubsiteR Subsite getSubsite-|]--instance Yesod Y where- approot _ = fromString ""--getRootR :: Handler ()-getRootR = return ()--getFooR :: Handler ()-getFooR = return ()--runner :: Session () -> IO ()-runner f = toWaiApp Y >>= runSession f--case_sanity :: IO ()-case_sanity = runner $ do- res <- request defaultRequest- assertBody mempty res--noOverloadedTest :: [Spec]-noOverloadedTest = describe "Test.NoOverloadedStrings"- [ it "sanity" case_sanity- ]
− test/Test/Widget.hs
@@ -1,92 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-module Test.Widget (widgetTest) where--import Test.Hspec-import Test.Hspec.HUnit ()--import Yesod.Core hiding (Request)-import Text.Julius-import Text.Lucius-import Text.Hamlet--import Network.Wai-import Network.Wai.Test--data Y = Y--mkMessage "Y" "test" "en"--type Strings = [String]--mkYesod "Y" [parseRoutes|-/ RootR GET-/foo/*Strings MultiR GET-/whamlet WhamletR GET-/towidget TowidgetR GET-|]--instance Yesod Y where- approot _ = "http://test"--getRootR :: Handler RepHtml-getRootR = defaultLayout $ toWidgetBody [julius|<not escaped>|]--getMultiR :: [String] -> Handler ()-getMultiR _ = return ()--data Msg = Hello | Goodbye-instance RenderMessage Y Msg where- renderMessage _ ("en":_) Hello = "Hello"- renderMessage _ ("es":_) Hello = "Hola"- renderMessage _ ("en":_) Goodbye = "Goodbye"- renderMessage _ ("es":_) Goodbye = "Adios"- renderMessage a (_:xs) y = renderMessage a xs y- renderMessage a [] y = renderMessage a ["en"] y--getTowidgetR :: Handler RepHtml-getTowidgetR = defaultLayout $ do- toWidget [julius|foo|] :: Widget- toWidgetHead [julius|foo|]- toWidgetBody [julius|foo|]-- toWidget [lucius|foo{bar:baz}|]- toWidgetHead [lucius|foo{bar:baz}|]-- toWidget [hamlet|<foo>|] :: Widget- toWidgetHead [hamlet|<foo>|]- toWidgetBody [hamlet|<foo>|]--getWhamletR :: Handler RepHtml-getWhamletR = defaultLayout [whamlet|-<h1>Test-<h2>@{WhamletR}-<h3>_{Goodbye}-<h3>_{MsgAnother}-^{embed}-|]- where- embed = [whamlet|<h4>Embed|]--widgetTest :: [Spec]-widgetTest = describe "Test.Widget"- [ it "addJuliusBody" case_addJuliusBody- , it "whamlet" case_whamlet- ]--runner :: Session () -> IO ()-runner f = toWaiApp Y >>= runSession f--case_addJuliusBody :: IO ()-case_addJuliusBody = runner $ do- res <- request defaultRequest- assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script><not escaped></script></body></html>" res--case_whamlet :: IO ()-case_whamlet = runner $ do- res <- request defaultRequest- { pathInfo = ["whamlet"]- , requestHeaders = [("Accept-Language", "es")]- }- assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><h1>Test</h1><h2>http://test/whamlet</h2><h3>Adios</h3><h3>String</h3><h4>Embed</h4></body></html>" res
+ test/YesodCoreTest/CleanPath.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.CleanPath (cleanPathTest, Widget) where++import Test.Hspec+import Test.Hspec.HUnit()++import Yesod.Core hiding (Request)++import Network.Wai+import Network.Wai.Test+import Network.HTTP.Types (status200, decodePathSegments)++import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.Text as TS++data Subsite = Subsite++getSubsite :: a -> Subsite+getSubsite = const Subsite++data SubsiteRoute = SubsiteRoute [TS.Text]+ deriving (Eq, Show, Read)+type instance Route Subsite = SubsiteRoute+instance RenderRoute SubsiteRoute where+ renderRoute (SubsiteRoute x) = (x, [])++instance YesodDispatch Subsite master where+ yesodDispatch _ _ pieces _ _ = Just $ const $ return $ responseLBS+ status200+ [ ("Content-Type", "SUBSITE")+ ] $ L8.pack $ show pieces++data Y = Y+mkYesod "Y" [parseRoutes|+/foo FooR GET+/foo/#String FooStringR GET+/bar BarR GET+/subsite SubsiteR Subsite getSubsite+/plain PlainR GET+|]++instance Yesod Y where+ approot _ = "http://test"+ cleanPath _ ["bar", ""] = Right ["bar"]+ cleanPath _ ["bar"] = Left ["bar", ""]+ cleanPath _ s =+ if corrected == s+ then Right s+ else Left corrected+ where+ corrected = filter (not . TS.null) s++getFooR :: Handler RepPlain+getFooR = return $ RepPlain "foo"++getFooStringR :: String -> Handler RepPlain+getFooStringR = return . RepPlain . toContent++getBarR, getPlainR :: Handler RepPlain+getBarR = return $ RepPlain "bar"+getPlainR = return $ RepPlain "plain"++cleanPathTest :: [Spec]+cleanPathTest =+ describe "Test.CleanPath"+ [ it "remove trailing slash" removeTrailingSlash+ , it "noTrailingSlash" noTrailingSlash+ , it "add trailing slash" addTrailingSlash+ , it "has trailing slash" hasTrailingSlash+ , it "/foo/something" fooSomething+ , it "subsite dispatch" subsiteDispatch+ , it "redirect with query string" redQueryString+ ]++runner :: Session () -> IO ()+runner f = toWaiApp Y >>= runSession f++removeTrailingSlash :: IO ()+removeTrailingSlash = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/foo/"+ }+ assertStatus 301 res+ assertHeader "Location" "http://test/foo" res++noTrailingSlash :: IO ()+noTrailingSlash = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/foo"+ }+ assertStatus 200 res+ assertContentType "text/plain; charset=utf-8" res+ assertBody "foo" res++addTrailingSlash :: IO ()+addTrailingSlash = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/bar"+ }+ assertStatus 301 res+ assertHeader "Location" "http://test/bar/" res++hasTrailingSlash :: IO ()+hasTrailingSlash = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/bar/"+ }+ assertStatus 200 res+ assertContentType "text/plain; charset=utf-8" res+ assertBody "bar" res++fooSomething :: IO ()+fooSomething = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/foo/something"+ }+ assertStatus 200 res+ assertContentType "text/plain; charset=utf-8" res+ assertBody "something" res++subsiteDispatch :: IO ()+subsiteDispatch = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/subsite/1/2/3/"+ }+ assertStatus 200 res+ assertContentType "SUBSITE" res+ assertBody "[\"1\",\"2\",\"3\",\"\"]" res++redQueryString :: IO ()+redQueryString = runner $ do+ res <- request defaultRequest+ { pathInfo = decodePathSegments "/plain/"+ , rawQueryString = "?foo=bar"+ }+ assertStatus 301 res+ assertHeader "Location" "http://test/plain?foo=bar" res
+ test/YesodCoreTest/ErrorHandling.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}+module YesodCoreTest.ErrorHandling+ ( errorHandlingTest+ , Widget+ ) where+import Yesod.Core+import Test.Hspec+import Test.Hspec.HUnit()+import Network.Wai+import Network.Wai.Test+import Text.Hamlet (hamlet)+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as S8+import Yesod.Internal.TestApi+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL+import Control.Exception (SomeException)++data App = App++mkYesod "App" [parseRoutes|+/ HomeR GET+/not_found NotFoundR POST+/first_thing FirstThingR POST+/after_runRequestBody AfterRunRequestBodyR POST+|]++instance Yesod App where approot _ = ""++getHomeR :: Handler RepHtml+getHomeR = defaultLayout $ toWidget [hamlet|+!!!++<html>+ <body>+ <form method=post action=@{NotFoundR}>+ <input type=submit value="Not found">+ <form method=post action=@{FirstThingR}>+ <input type=submit value="Error is thrown first thing in handler">+ <form method=post action=@{AfterRunRequestBodyR}>+ <input type=submit value="BUGGY: Error thrown after runRequestBody">+|]++postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml+postNotFoundR = do+ (_, _files) <- runRequestBody+ _ <- notFound+ getHomeR++postFirstThingR = do+ _ <- error "There was an error 3.14159"+ getHomeR++postAfterRunRequestBodyR = do+ x <- runRequestBody+ _ <- error $ show x+ getHomeR++errorHandlingTest :: [Spec]+errorHandlingTest = describe "Test.ErrorHandling"+ [ it "says not found" caseNotFound+ , it "says 'There was an error' before runRequestBody" caseBefore+ , it "says 'There was an error' after runRequestBody" caseAfter+ , it "catchIter handles internal exceptions" caseCatchIter+ ]++runner :: Session () -> IO ()+runner f = toWaiApp App >>= runSession f++caseNotFound :: IO ()+caseNotFound = runner $ do+ res <- request defaultRequest+ { pathInfo = ["not_found"]+ , requestMethod = "POST"+ }+ assertStatus 404 res+ assertBodyContains "Not Found" res++caseBefore :: IO ()+caseBefore = runner $ do+ res <- request defaultRequest+ { pathInfo = ["first_thing"]+ , requestMethod = "POST"+ }+ assertStatus 500 res+ assertBodyContains "There was an error 3.14159" res++caseAfter :: IO ()+caseAfter = runner $ do+ let content = "foo=bar&baz=bin12345"+ res <- srequest SRequest+ { simpleRequest = defaultRequest+ { pathInfo = ["after_runRequestBody"]+ , requestMethod = "POST"+ , requestHeaders =+ [ ("content-type", "application/x-www-form-urlencoded")+ , ("content-length", S8.pack $ show $ L.length content)+ ]+ }+ , simpleRequestBody = content+ }+ assertStatus 500 res+ assertBodyContains "bin12345" res++caseCatchIter :: IO ()+caseCatchIter = E.run_ $ E.enumList 8 (replicate 1000 "foo") E.$$ flip catchIter ignorer $ do+ _ <- EL.consume+ error "foo"+ where+ ignorer :: SomeException -> E.Iteratee a IO ()+ ignorer _ = return ()
+ test/YesodCoreTest/Exceptions.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.Exceptions (exceptionsTest, Widget) where++import Test.Hspec+import Test.Hspec.HUnit ()++import Yesod.Core hiding (Request)+import Network.Wai.Test++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 :: Handler ()+getRootR = error "FOOBAR" >> return ()++exceptionsTest :: [Spec]+exceptionsTest = describe "Test.Exceptions"+ [ it "500" case500+ ]++runner :: Session () -> IO ()+runner f = toWaiApp Y >>= runSession f++case500 :: IO ()+case500 = runner $ do+ res <- request defaultRequest+ assertStatus 500 res+ assertBody "FOOBAR" res
+ test/YesodCoreTest/InternalRequest.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+module YesodCoreTest.InternalRequest (internalRequestTest) where++import Data.List (nub)+import System.Random (StdGen, mkStdGen)++import Network.Wai as W+import Network.Wai.Test+import Yesod.Internal.TestApi (randomString, parseWaiRequest')+import Yesod.Request (Request (..))+import Test.Hspec++randomStringSpecs :: [Spec]+randomStringSpecs = describe "Yesod.Internal.Request.randomString"+ [ it "looks reasonably random" looksRandom+ , it "does not repeat itself" $ noRepeat 10 100+ ]++-- NOTE: this testcase may break on other systems/architectures if+-- mkStdGen is not identical everywhere (is it?).+looksRandom = randomString 20 (mkStdGen 0) == "VH9SkhtptqPs6GqtofVg"++noRepeat len n = length (nub $ map (randomString len . mkStdGen) [1..n]) == n+++-- For convenience instead of "(undefined :: StdGen)".+g :: StdGen+g = undefined+++nonceSpecs :: [Spec]+nonceSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqNonce)"+ [ it "is Nothing if sessions are disabled" noDisabledNonce+ , it "ignores pre-existing nonce if sessions are disabled" ignoreDisabledNonce+ , it "uses preexisting nonce in session" useOldNonce+ , it "generates a new nonce for sessions without nonce" generateNonce+ ]++noDisabledNonce = reqNonce r == Nothing where+ r = parseWaiRequest' defaultRequest [] Nothing g++ignoreDisabledNonce = reqNonce r == Nothing where+ r = parseWaiRequest' defaultRequest [("_NONCE", "old")] Nothing g++useOldNonce = reqNonce r == Just "old" where+ r = parseWaiRequest' defaultRequest [("_NONCE", "old")] (Just undefined) g++generateNonce = reqNonce r /= Nothing where+ r = parseWaiRequest' defaultRequest [("_NONCE", "old")] (Just undefined) g+++langSpecs :: [Spec]+langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)"+ [ it "respects Accept-Language" respectAcceptLangs+ , it "respects sessions" respectSessionLang+ , it "respects cookies" respectCookieLang+ , it "respects queries" respectQueryLang+ , it "prioritizes correctly" prioritizeLangs+ ]++respectAcceptLangs = reqLangs r == ["accept1", "accept2"] where+ r = parseWaiRequest' defaultRequest+ { requestHeaders = [("Accept-Language", "accept1, accept2")] } [] Nothing g++respectSessionLang = reqLangs r == ["session"] where+ r = parseWaiRequest' defaultRequest [("_LANG", "session")] Nothing g++respectCookieLang = reqLangs r == ["cookie"] where+ r = parseWaiRequest' defaultRequest+ { requestHeaders = [("Cookie", "_LANG=cookie")]+ } [] Nothing g++respectQueryLang = reqLangs r == ["query"] where+ r = parseWaiRequest' defaultRequest { queryString = [("_LANG", Just "query")] } [] Nothing g++prioritizeLangs = reqLangs r == ["query", "cookie", "session", "accept1", "accept2"] where+ r = parseWaiRequest' defaultRequest+ { requestHeaders = [ ("Accept-Language", "accept1, accept2")+ , ("Cookie", "_LANG=cookie")+ ]+ , queryString = [("_LANG", Just "query")]+ } [("_LANG", "session")] Nothing g+++internalRequestTest :: [Spec]+internalRequestTest = descriptions [ randomStringSpecs+ , nonceSpecs+ , langSpecs+ ]++main = hspec internalRequestTest
+ test/YesodCoreTest/Links.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.Links (linksTest, Widget) where++import Test.Hspec+import Test.Hspec.HUnit ()++import Yesod.Core hiding (Request)+import Text.Hamlet+import Network.Wai.Test++data Y = Y+mkYesod "Y" [parseRoutes|+/ RootR GET+|]++instance Yesod Y where+ approot _ = ""++getRootR :: Handler RepHtml+getRootR = defaultLayout $ addHamlet [hamlet|<a href=@{RootR}>|]++linksTest :: [Spec]+linksTest = describe "Test.Links"+ [ it "linkToHome" case_linkToHome+ ]++runner :: Session () -> IO ()+runner f = toWaiApp Y >>= runSession f++case_linkToHome :: IO ()+case_linkToHome = runner $ do+ res <- request defaultRequest+ assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a></body></html>" res
+ test/YesodCoreTest/Media.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.Media (mediaTest, Widget) where++import Test.Hspec+import Test.Hspec.HUnit ()+import Yesod.Core hiding (Request)+import Network.Wai+import Network.Wai.Test+import Text.Lucius++data Y = Y+mkYesod "Y" [parseRoutes|+/ RootR GET+/static StaticR GET+|]++instance Yesod Y where+ approot _ = ""+ addStaticContent _ _ content = do+ tm <- getRouteToMaster+ route <- getCurrentRoute+ case fmap tm route of+ Just StaticR -> return $ Just $ Left $+ if content == "foo2{bar:baz}"+ then "screen.css"+ else "all.css"+ _ -> return Nothing++getRootR :: Handler RepHtml+getRootR = defaultLayout $ do+ addCassius [lucius|foo1{bar:baz}|]+ addCassiusMedia "screen" [lucius|foo2{bar:baz}|]+ addCassius [lucius|foo3{bar:baz}|]++getStaticR :: Handler RepHtml+getStaticR = getRootR++runner :: Session () -> IO ()+runner f = toWaiApp Y >>= runSession f++caseMedia :: IO ()+caseMedia = runner $ do+ res <- request defaultRequest+ assertStatus 200 res+ flip assertBody res "<!DOCTYPE html>\n<html><head><title></title><style>foo1{bar:baz}foo3{bar:baz}</style><style media=\"screen\">foo2{bar:baz}</style></head><body></body></html>"++caseMediaLink :: IO ()+caseMediaLink = runner $ do+ res <- request defaultRequest { pathInfo = ["static"] }+ 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>"++mediaTest :: [Spec]+mediaTest = describe "Test.Media"+ [ it "media" caseMedia+ , it "media link" caseMediaLink+ ]
+ test/YesodCoreTest/NoOverloadedStrings.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.NoOverloadedStrings (noOverloadedTest, Widget) where++import Test.Hspec+import Test.Hspec.HUnit ()++import Yesod.Core hiding (Request)+import Network.Wai.Test+import Data.Monoid (mempty)+import Data.String (fromString)++data Subsite = Subsite++getSubsite :: a -> Subsite+getSubsite = const Subsite++mkYesodSub "Subsite" [] [parseRoutes|+/bar BarR GET+|]++getBarR :: GHandler Subsite m ()+getBarR = return ()++data Y = Y+mkYesod "Y" [parseRoutes|+/ RootR GET+/foo FooR GET+/subsite SubsiteR Subsite getSubsite+|]++instance Yesod Y where+ approot _ = fromString ""++getRootR :: Handler ()+getRootR = return ()++getFooR :: Handler ()+getFooR = return ()++runner :: Session () -> IO ()+runner f = toWaiApp Y >>= runSession f++case_sanity :: IO ()+case_sanity = runner $ do+ res <- request defaultRequest+ assertBody mempty res++noOverloadedTest :: [Spec]+noOverloadedTest = describe "Test.NoOverloadedStrings"+ [ it "sanity" case_sanity+ ]
+ test/YesodCoreTest/Widget.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.Widget (widgetTest) where++import Test.Hspec+import Test.Hspec.HUnit ()++import Yesod.Core hiding (Request)+import Text.Julius+import Text.Lucius+import Text.Hamlet++import Network.Wai+import Network.Wai.Test++data Y = Y++mkMessage "Y" "test" "en"++type Strings = [String]++mkYesod "Y" [parseRoutes|+/ RootR GET+/foo/*Strings MultiR GET+/whamlet WhamletR GET+/towidget TowidgetR GET+|]++instance Yesod Y where+ approot _ = "http://test"++getRootR :: Handler RepHtml+getRootR = defaultLayout $ toWidgetBody [julius|<not escaped>|]++getMultiR :: [String] -> Handler ()+getMultiR _ = return ()++data Msg = Hello | Goodbye+instance RenderMessage Y Msg where+ renderMessage _ ("en":_) Hello = "Hello"+ renderMessage _ ("es":_) Hello = "Hola"+ renderMessage _ ("en":_) Goodbye = "Goodbye"+ renderMessage _ ("es":_) Goodbye = "Adios"+ renderMessage a (_:xs) y = renderMessage a xs y+ renderMessage a [] y = renderMessage a ["en"] y++getTowidgetR :: Handler RepHtml+getTowidgetR = defaultLayout $ do+ toWidget [julius|foo|] :: Widget+ toWidgetHead [julius|foo|]+ toWidgetBody [julius|foo|]++ toWidget [lucius|foo{bar:baz}|]+ toWidgetHead [lucius|foo{bar:baz}|]++ toWidget [hamlet|<foo>|] :: Widget+ toWidgetHead [hamlet|<foo>|]+ toWidgetBody [hamlet|<foo>|]++getWhamletR :: Handler RepHtml+getWhamletR = defaultLayout [whamlet|+<h1>Test+<h2>@{WhamletR}+<h3>_{Goodbye}+<h3>_{MsgAnother}+^{embed}+|]+ where+ embed = [whamlet|<h4>Embed|]++widgetTest :: [Spec]+widgetTest = describe "Test.Widget"+ [ it "addJuliusBody" case_addJuliusBody+ , it "whamlet" case_whamlet+ ]++runner :: Session () -> IO ()+runner f = toWaiApp Y >>= runSession f++case_addJuliusBody :: IO ()+case_addJuliusBody = runner $ do+ res <- request defaultRequest+ assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script><not escaped></script></body></html>" res++case_whamlet :: IO ()+case_whamlet = runner $ do+ res <- request defaultRequest+ { pathInfo = ["whamlet"]+ , requestHeaders = [("Accept-Language", "es")]+ }+ assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><h1>Test</h1><h2>http://test/whamlet</h2><h3>Adios</h3><h3>String</h3><h4>Embed</h4></body></html>" res
− test/main.hs
@@ -1,22 +0,0 @@-import Test.Hspec--import Test.CleanPath-import Test.Exceptions-import Test.Widget-import Test.Media-import Test.Links-import Test.NoOverloadedStrings-import Test.InternalRequest-import Test.ErrorHandling--main :: IO ()-main = hspecX $ descriptions $- [ cleanPathTest- , exceptionsTest- , widgetTest- , mediaTest- , linksTest- , noOverloadedTest- , internalRequestTest- , errorHandlingTest- ]
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 0.9.3.3+version: 0.9.3.4 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -16,15 +16,15 @@ homepage: http://www.yesodweb.com/ extra-source-files: test/en.msg- test/Test/NoOverloadedStrings.hs- test/Test/Media.hs- test/Test/Exceptions.hs- test/Test/Widget.hs- test/Test/CleanPath.hs- test/Test/Links.hs- test/Test/InternalRequest.hs- test/Test/ErrorHandling.hs- test/main.hs+ test/YesodCoreTest/NoOverloadedStrings.hs+ test/YesodCoreTest/Media.hs+ test/YesodCoreTest/Exceptions.hs+ test/YesodCoreTest/Widget.hs+ test/YesodCoreTest/CleanPath.hs+ test/YesodCoreTest/Links.hs+ test/YesodCoreTest/InternalRequest.hs+ test/YesodCoreTest/ErrorHandling.hs+ test.hs flag test description: Build the executable to run unit tests@@ -34,43 +34,49 @@ library if flag(ghc7)- build-depends: base >= 4.3 && < 5+ build-depends: base >= 4.3 && < 5 cpp-options: -DGHC7 else- build-depends: base >= 4 && < 4.3- build-depends: time >= 1.1.4 && < 1.4- , wai >= 0.4 && < 0.5- , wai-extra >= 0.4.1 && < 0.5- , bytestring >= 0.9.1.4 && < 0.10- , text >= 0.5 && < 0.12+ build-depends: base >= 4 && < 4.3++ -- Work around a bug in cabal. Without this, wai-test doesn't get built and+ -- we have a missing dependency during --enable-tests builds.+ if flag(test)+ build-depends: wai-test++ build-depends: time >= 1.1.4+ , wai >= 0.4 && < 0.5+ , wai-extra >= 0.4.1 && < 0.5+ , bytestring >= 0.9.1.4 && < 0.10+ , text >= 0.7 && < 0.12 , template-haskell- , path-pieces >= 0.0 && < 0.1- , hamlet >= 0.10 && < 0.11- , shakespeare >= 0.10 && < 0.11- , shakespeare-js >= 0.10 && < 0.11- , shakespeare-css >= 0.10 && < 0.11- , blaze-builder >= 0.2.1 && < 0.4- , transformers >= 0.2 && < 0.3- , clientsession >= 0.7.3.1 && < 0.8- , random >= 1.0.0.2 && < 1.1- , cereal >= 0.2 && < 0.4- , old-locale >= 1.0.0.2 && < 1.1- , failure >= 0.1 && < 0.2- , containers >= 0.2 && < 0.5- , monad-control >= 0.2 && < 0.3- , enumerator >= 0.4.7 && < 0.5- , cookie >= 0.3 && < 0.4- , blaze-html >= 0.4.1.3 && < 0.5- , http-types >= 0.6.5 && < 0.7- , case-insensitive >= 0.2 && < 0.4- , parsec >= 2 && < 3.2- , directory >= 1 && < 1.2- , data-object >= 0.3 && < 0.4- , data-object-yaml >= 0.3 && < 0.4+ , path-pieces >= 0.0 && < 0.1+ , hamlet >= 0.10 && < 0.11+ , shakespeare >= 0.10 && < 0.11+ , shakespeare-js >= 0.10 && < 0.11+ , shakespeare-css >= 0.10 && < 0.11+ , blaze-builder >= 0.2.1.4 && < 0.4+ , transformers >= 0.2.2 && < 0.3+ , clientsession >= 0.7.3.1 && < 0.8+ , random >= 1.0.0.2 && < 1.1+ , cereal >= 0.3 && < 0.4+ , old-locale >= 1.0.0.2 && < 1.1+ , failure >= 0.1 && < 0.2+ , containers >= 0.2 && < 0.5+ , monad-control >= 0.2 && < 0.3+ , enumerator >= 0.4.8 && < 0.5+ , cookie >= 0.3 && < 0.4+ , blaze-html >= 0.4.1.3 && < 0.5+ , http-types >= 0.6.5 && < 0.7+ , case-insensitive >= 0.2+ , parsec >= 2 && < 3.2+ , directory >= 1 && < 1.2+ , data-object >= 0.3 && < 0.4+ , data-object-yaml >= 0.3 && < 0.4 -- for logger. Probably logger should be a separate package- , strict-concurrency >= 0.2.4 && < 0.2.5- , vector >= 0.9 && < 0.10- , aeson-native >= 0.3.3.1 && < 0.4+ , strict-concurrency >= 0.2.4 && < 0.2.5+ , vector >= 0.9 && < 0.10+ , aeson >= 0.3 exposed-modules: Yesod.Content Yesod.Core@@ -90,23 +96,21 @@ Yesod.Internal.RouteParsing Paths_yesod_core ghc-options: -Wall- if flag(test)- Buildable: False -test-suite runtests+test-suite tests type: exitcode-stdio-1.0- main-is: main.hs+ main-is: ../test.hs hs-source-dirs: test if flag(ghc7) type: exitcode-stdio-1.0 build-depends: base >= 4.3 && < 5 cpp-options: -DGHC7- main-is: main.hs+ main-is: test.hs else type: exitcode-stdio-1.0 build-depends: base >= 4 && < 4.3- main-is: main.hs+ main-is: test.hs cpp-options: -DTEST build-depends: hspec >= 0.8 && < 0.10 ,wai-test >= 0.1.2 && < 0.2