yesod-core 1.0.0.2 → 1.0.1
raw patch · 11 files changed
+256/−10 lines, 11 files
Files
- Yesod/Handler.hs +7/−0
- Yesod/Request.hs +3/−0
- test/YesodCoreTest.hs +32/−0
- test/YesodCoreTest/JsLoader.hs +41/−0
- test/YesodCoreTest/JsLoaderSites/Bottom.hs +17/−0
- test/YesodCoreTest/JsLoaderSites/HeadAsync.hs +16/−0
- test/YesodCoreTest/Redirect.hs +59/−0
- test/YesodCoreTest/WaiSubsite.hs +39/−0
- test/YesodCoreTest/YesodTest.hs +19/−0
- test/test.hs +5/−0
- yesod-core.cabal +18/−10
Yesod/Handler.hs view
@@ -76,6 +76,7 @@ , setSession , setSessionBS , deleteSession+ , clearSession -- ** Ultimate destination , setUltDest , setUltDestCurrent@@ -699,6 +700,12 @@ -- | Unsets a session variable. See 'setSession'. deleteSession :: Text -> GHandler sub master () deleteSession = modify . modSession . Map.delete++-- | Clear all session variables.+--+-- Since: 1.0.1+clearSession :: GHandler sub master ()+clearSession = modify $ \x -> x { ghsSession = Map.empty } modSession :: (SessionMap -> SessionMap) -> GHState -> GHState modSession f x = x { ghsSession = f $ ghsSession x }
Yesod/Request.hs view
@@ -51,6 +51,9 @@ -- -- * Accept-Language HTTP header. --+-- Yesod will seek the first language from the returned list matched with languages supporting by your application. This language will be used to render i18n templates.+-- If a matching language is not found the default language will be used.+-- -- This is handled by parseWaiRequest (not exposed). languages :: GHandler s m [Text] languages = reqLangs `liftM` getRequest
+ test/YesodCoreTest.hs view
@@ -0,0 +1,32 @@+module YesodCoreTest (specs) where ++import YesodCoreTest.CleanPath+import YesodCoreTest.Exceptions+import YesodCoreTest.Widget+import YesodCoreTest.Media+import YesodCoreTest.Links+import YesodCoreTest.NoOverloadedStrings+import YesodCoreTest.InternalRequest+import YesodCoreTest.ErrorHandling+import YesodCoreTest.Cache+import qualified YesodCoreTest.WaiSubsite as WaiSubsite+import qualified YesodCoreTest.Redirect as Redirect+import qualified YesodCoreTest.JsLoader as JsLoader++import Test.Hspec++specs :: [Specs]+specs = + [ cleanPathTest+ , exceptionsTest+ , widgetTest+ , mediaTest+ , linksTest+ , noOverloadedTest+ , internalRequestTest+ , errorHandlingTest+ , cacheTest+ , WaiSubsite.specs+ , Redirect.specs+ , JsLoader.specs+ ]
+ test/YesodCoreTest/JsLoader.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.JsLoader (specs, Widget) where++import YesodCoreTest.JsLoaderSites.HeadAsync (HA(..))+import YesodCoreTest.JsLoaderSites.Bottom (B(..))++import Test.Hspec+import Test.Hspec.HUnit ()++import Yesod.Core hiding (Request)+import Network.Wai.Test++data H = H+mkYesod "H" [parseRoutes|+/ HeadR GET+|]+instance Yesod H where+ jsLoader _ = BottomOfHeadBlocking++getHeadR :: Handler RepHtml+getHeadR = defaultLayout $ addScriptRemote "load.js"++specs :: [Spec]+specs = describe "Test.JsLoader" [+ it "link from head" $ runner H $ do+ res <- request defaultRequest+ assertBody "<!DOCTYPE html>\n<html><head><title></title><script src=\"load.js\"></script></head><body></body></html>" res++ , it "link from head async" $ runner HA $ do+ res <- request defaultRequest+ assertBody "<!DOCTYPE html>\n<html><head><title></title><script src=\"yepnope.js\"></script><script>yepnope({load:[\"load.js\"]});</script></head><body></body></html>" res++ , it "link from bottom" $ runner B $ do+ res <- request defaultRequest+ assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script src=\"load.js\"></script></body></html>" res+ ]++runner :: (YesodDispatch master master, Yesod master) => master -> Session () -> IO ()+runner app f = toWaiApp app >>= runSession f
+ test/YesodCoreTest/JsLoaderSites/Bottom.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.JsLoaderSites.Bottom (B(..), Widget) where++import Yesod.Core++data B = B+mkYesod "B" [parseRoutes|+/ BottomR GET+|]+instance Yesod B where+ jsLoader _ = BottomOfBody++getBottomR :: Handler RepHtml+getBottomR = defaultLayout $ addScriptRemote "load.js"+
+ test/YesodCoreTest/JsLoaderSites/HeadAsync.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module YesodCoreTest.JsLoaderSites.HeadAsync (HA(..), Widget) where++import Yesod.Core++data HA = HA+mkYesod "HA" [parseRoutes|+/ HeadAsyncR GET+|]+instance Yesod HA where+ jsLoader _ = BottomOfHeadAsync $ loadJsYepnope $ Left "yepnope.js"++getHeadAsyncR :: Handler RepHtml+getHeadAsyncR = defaultLayout $ addScriptRemote "load.js"
+ test/YesodCoreTest/Redirect.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}+module YesodCoreTest.Redirect (specs, Widget) where++import YesodCoreTest.YesodTest+import Yesod.Handler (redirectWith)+import qualified Network.HTTP.Types as H++data Y = Y+mkYesod "Y" [parseRoutes|+/ RootR GET+/r301 R301 GET+/r303 R303 GET+/r307 R307 GET+/rregular RRegular GET+|]+instance Yesod Y where approot = ApprootStatic "http://test"+app :: Session () -> IO ()+app = yesod Y++getRootR :: Handler ()+getRootR = return ()++getR301, getR303, getR307, getRRegular :: Handler ()+getR301 = redirectWith H.status301 RootR+getR303 = redirectWith H.status303 RootR+getR307 = redirectWith H.status307 RootR+getRRegular = redirect RootR++specs :: [Spec]+specs = describe "Redirect" [+ it "301 redirect" $ app $ do+ res <- request defaultRequest { pathInfo = ["r301"] }+ assertStatus 301 res+ assertBodyContains "" res++ , it "303 redirect" $ app $ do+ res <- request defaultRequest { pathInfo = ["r303"] }+ assertStatus 303 res+ assertBodyContains "" res++ , it "307 redirect" $ app $ do+ res <- request defaultRequest { pathInfo = ["r307"] }+ assertStatus 307 res+ assertBodyContains "" res++ , it "303 redirect for regular, HTTP 1.1" $ app $ do+ res <- request defaultRequest {+ pathInfo = ["rregular"]+ }+ assertStatus 303 res+ assertBodyContains "" res+ , it "302 redirect for regular, HTTP 1.0" $ app $ do+ res <- request defaultRequest {+ pathInfo = ["rregular"]+ , httpVersion = H.http10+ }+ assertStatus 302 res+ assertBodyContains "" res+ ]
+ test/YesodCoreTest/WaiSubsite.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}+module YesodCoreTest.WaiSubsite (specs, Widget) where++import YesodCoreTest.YesodTest+import Yesod.Core+import qualified Network.HTTP.Types as H++myApp :: Application+myApp _ = return $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI"++getApp :: a -> WaiSubsite+getApp _ = WaiSubsite myApp++data Y = Y+mkYesod "Y" [parseRoutes|+/ RootR GET+/sub WaiSubsiteR WaiSubsite getApp+|]++instance Yesod Y++app :: Session () -> IO ()+app = yesod Y++getRootR :: Handler ()+getRootR = return ()++specs :: [Spec]+specs = describe "WaiSubsite" [+ it "root" $ app $ do+ res <- request defaultRequest { pathInfo = [] }+ assertStatus 200 res+ assertBodyContains "" res++ , it "subsite" $ app $ do+ res <- request defaultRequest { pathInfo = ["sub", "foo"] }+ assertStatus 200 res+ assertBodyContains "WAI" res+ ]
+ test/YesodCoreTest/YesodTest.hs view
@@ -0,0 +1,19 @@+-- this is being re-worked into a general-purpose testing module for Yesod apps+module YesodCoreTest.YesodTest+( yesod+ , parseRoutes, mkYesod, yesodDispatch, renderRoute, Yesod(..)+ , redirect+ , Approot (..)+ , module Network.Wai+ , module Network.Wai.Test+ , module Test.Hspec+) where++import Yesod.Core hiding (Request)+import Network.Wai.Test+import Network.Wai+import Test.Hspec+import Test.Hspec.HUnit()++yesod :: (YesodDispatch y y, Yesod y) => y -> Session a -> IO a+yesod app f = toWaiApp app >>= runSession f
+ test/test.hs view
@@ -0,0 +1,5 @@+import Test.Hspec+import qualified YesodCoreTest++main :: IO ()+main = hspecX $ descriptions $ YesodCoreTest.specs
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.0.0.2+version: 1.0.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -15,18 +15,26 @@ build-type: Simple homepage: http://www.yesodweb.com/ extra-source-files:- test/en.msg- test/YesodCoreTest/NoOverloadedStrings.hs+ test.hs+ test/YesodCoreTest.hs+ test/YesodCoreTest/Cache.hs+ test/YesodCoreTest/CleanPath.hs+ test/YesodCoreTest/ErrorHandling.hs+ test/YesodCoreTest/Exceptions.hs+ test/YesodCoreTest/InternalRequest.hs+ test/YesodCoreTest/JsLoader.hs+ test/YesodCoreTest/JsLoaderSites/Bottom.hs+ test/YesodCoreTest/JsLoaderSites/HeadAsync.hs+ test/YesodCoreTest/Links.hs test/YesodCoreTest/Media.hs test/YesodCoreTest/MediaData.hs- test/YesodCoreTest/Exceptions.hs+ test/YesodCoreTest/NoOverloadedStrings.hs+ test/YesodCoreTest/Redirect.hs+ test/YesodCoreTest/WaiSubsite.hs test/YesodCoreTest/Widget.hs- test/YesodCoreTest/CleanPath.hs- test/YesodCoreTest/Links.hs- test/YesodCoreTest/InternalRequest.hs- test/YesodCoreTest/ErrorHandling.hs- test/YesodCoreTest/Cache.hs- test.hs+ test/YesodCoreTest/YesodTest.hs+ test/en.msg+ test/test.hs flag test description: Build the executable to run unit tests