yesod-core 1.2.0 → 1.2.0.1

raw patch · 4 files changed

+147/−19 lines, 4 files

Files

• test/YesodCoreTest/NoOverloadedStringsSub.hs +25/−0
• test/YesodCoreTest/Reps.hs +90/−0
• test/YesodCoreTest/Streaming.hs +30/−0
• yesod-core.cabal +2/−19

@@ -0,0 +1,25 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+module YesodCoreTest.NoOverloadedStringsSub where++import Yesod.Core+import Network.Wai+import Yesod.Core.Types++data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerT master IO) -> Application)++mkYesodSubData "Subsite" [parseRoutes|+/bar BarR GET+/baz BazR GET+/bin BinR GET+/has-one-piece/#Int OnePiecesR GET+/has-two-pieces/#Int/#Int TwoPiecesR GET+/has-three-pieces/#Int/#Int/#Int ThreePiecesR GET+|]++instance Yesod master => YesodSubDispatch Subsite (HandlerT master IO) where+    yesodSubDispatch ysre =+        f ysre+      where+        Subsite f = ysreGetSub ysre $ yreSite $ ysreParentEnv ysre

@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-}+module YesodCoreTest.Reps (specs, Widget) where++import Yesod.Core+import Test.Hspec+import Network.Wai+import Network.Wai.Test+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Char8 as S8+import Data.String (IsString)+import Data.Text (Text)+import Data.Maybe (fromJust)+import Data.Monoid (Endo (..))+import qualified Control.Monad.Trans.Writer    as Writer+import qualified Data.Set as Set++data App = App++mkYesod "App" [parseRoutes|+/     HomeR GET !home+/json JsonR GET+/parent/#Int ParentR:+    /#Text/child ChildR !child+|]++instance Yesod App++specialHtml :: IsString a => a+specialHtml = "text/html; charset=special"++getHomeR :: Handler TypedContent+getHomeR = selectRep $ do+    rep typeHtml "HTML"+    rep specialHtml "HTMLSPECIAL"+    rep typeXml "XML"+    rep typeJson "JSON"++rep :: Monad m => ContentType -> Text -> Writer.Writer (Data.Monoid.Endo [ProvidedRep m]) ()+rep ct t = provideRepType ct $ return (t :: Text)++getJsonR :: Handler TypedContent+getJsonR = selectRep $ do+  rep typeHtml "HTML"+  provideRep $ return $ object ["message" .= ("Invalid Login" :: Text)]++handleChildR :: Int -> Text -> Handler ()+handleChildR _ _ = return ()++testRequest :: Int -- ^ http status code+            -> Request+            -> ByteString -- ^ expected body+            -> Spec+testRequest status req expected = it (S8.unpack $ fromJust $ lookup "Accept" $ requestHeaders req) $ do+    app <- toWaiApp App+    flip runSession app $ do+        sres <- request req+        assertStatus status sres+        assertBody expected sres++test :: String -- ^ accept header+     -> ByteString -- ^ expected body+     -> Spec+test accept expected =+    testRequest 200 (acceptRequest accept) expected++acceptRequest :: String -> Request+acceptRequest accept = defaultRequest+            { requestHeaders = [("Accept", S8.pack accept)]+            }++specs :: Spec+specs = do+  describe "selectRep" $ do+    test "application/json" "JSON"+    test (S8.unpack typeJson) "JSON"+    test "text/xml" "XML"+    test (S8.unpack typeXml) "XML"+    test "text/xml,application/json" "XML"+    test "text/xml;q=0.9,application/json;q=1.0" "JSON"+    test (S8.unpack typeHtml) "HTML"+    test "text/html" "HTML"+    test specialHtml "HTMLSPECIAL"+    testRequest 200 (acceptRequest "application/json") { pathInfo = ["json"] } "{\"message\":\"Invalid Login\"}"+    testRequest 406 (acceptRequest "text/foo") "no match found for accept header"+    test "text/*" "HTML"+    test "*/*" "HTML"+  describe "routeAttrs" $ do+    it "HomeR" $ routeAttrs HomeR `shouldBe` Set.singleton "home"+    it "JsonR" $ routeAttrs JsonR `shouldBe` Set.empty+    it "ChildR" $ routeAttrs (ParentR 5 $ ChildR "ignored") `shouldBe` Set.singleton "child"

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+module YesodCoreTest.Streaming (specs) where++import Yesod.Core+import Test.Hspec+import Network.Wai.Test+import Data.Text (Text)+import Data.ByteString (ByteString)++app :: LiteApp+app = liteApp $ dispatchTo $ respondSource typeHtml $ do+    sendChunk ("Hello " :: String)+    sendChunk ("World" :: ByteString)+    sendChunk ("!\n" :: Text)+    sendChunkHtml "<&>"++test :: String+     -> (SResponse -> Session ())+     -> Spec+test name f = it name $ do+    wapp <- toWaiApp app+    flip runSession wapp $ do+        sres <- request defaultRequest+        f sres++specs :: Spec+specs = describe "Streaming" $ do+    test "works" $ \sres -> do+        assertStatus 200 sres+        assertBody "Hello World!\n&lt;&amp;&gt;" sres

@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.2.0+version:         1.2.0.1 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -17,25 +17,8 @@ extra-source-files:   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/Json.hs-  test/YesodCoreTest/JsLoader.hs+  test/YesodCoreTest/*.hs   test/YesodCoreTest/JsLoaderSites/Bottom.hs-  test/YesodCoreTest/Links.hs-  test/YesodCoreTest/Media.hs-  test/YesodCoreTest/MediaData.hs-  test/YesodCoreTest/NoOverloadedStrings.hs-  test/YesodCoreTest/Redirect.hs-  test/YesodCoreTest/RequestBodySize.hs-  test/YesodCoreTest/WaiSubsite.hs-  test/YesodCoreTest/Widget.hs-  test/YesodCoreTest/YesodTest.hs-  test/YesodCoreTest/Auth.hs-  test/YesodCoreTest/LiteApp.hs   test/en.msg   test/test.hs