Hello community, here is the log from the commit of package ghc-yesod-test for openSUSE:Factory checked in at 2017-04-17 10:25:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yesod-test (Old) and /work/SRC/openSUSE:Factory/.ghc-yesod-test.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-yesod-test" Mon Apr 17 10:25:38 2017 rev:2 rq:485181 version:1.5.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yesod-test/ghc-yesod-test.changes 2016-12-26 21:45:05.078309066 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-yesod-test.new/ghc-yesod-test.changes 2017-04-17 10:25:55.677471194 +0200 @@ -1,0 +2,25 @@ +Tue Mar 7 11:19:16 UTC 2017 - [email protected] + +- Update to version 1.5.5 with cabal2obs. + +------------------------------------------------------------------- +Fri Dec 16 18:00:11 UTC 2016 - [email protected] + +- Update to version 1.5.4.1 with cabal2obs. + +------------------------------------------------------------------- +Sun Dec 4 19:48:14 UTC 2016 - [email protected] + +- Update to version 1.5.4 with cabal2obs. + +------------------------------------------------------------------- +Thu Sep 15 06:32:51 UTC 2016 - [email protected] + +- Update to version 1.5.3 revision 0 with cabal2obs. + +------------------------------------------------------------------- +Wed Aug 17 18:43:36 UTC 2016 - [email protected] + +- Update to version 1.5.2 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- yesod-test-1.5.1.1.tar.gz New: ---- yesod-test-1.5.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yesod-test.spec ++++++ --- /var/tmp/diff_new_pack.sXmwh9/_old 2017-04-17 10:25:58.721040168 +0200 +++ /var/tmp/diff_new_pack.sXmwh9/_new 2017-04-17 10:25:58.725039602 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-yesod-test # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,15 +19,14 @@ %global pkg_name yesod-test %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.5.1.1 +Version: 1.5.5 Release: 0 Summary: Integration testing for WAI/Yesod Applications License: MIT -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-HUnit-devel BuildRequires: ghc-attoparsec-devel BuildRequires: ghc-blaze-builder-devel @@ -43,6 +42,7 @@ BuildRequires: ghc-monad-control-devel BuildRequires: ghc-network-devel BuildRequires: ghc-persistent-devel +BuildRequires: ghc-pretty-show-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel @@ -58,7 +58,6 @@ BuildRequires: ghc-lifted-base-devel BuildRequires: ghc-yesod-form-devel %endif -# End cabal-rpm deps %description API docs and the README are available at @@ -78,20 +77,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ yesod-test-1.5.1.1.tar.gz -> yesod-test-1.5.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.1.1/ChangeLog.md new/yesod-test-1.5.5/ChangeLog.md --- old/yesod-test-1.5.1.1/ChangeLog.md 2016-04-19 07:16:14.000000000 +0200 +++ new/yesod-test-1.5.5/ChangeLog.md 2017-02-08 10:19:49.000000000 +0100 @@ -1,7 +1,27 @@ +## 1.5.5 + +* Fix warnings + +## 1.5.4.1 + +* Compilation fix for GHC 7.8 + +## 1.5.4 + +* yesod-test: add getLocation test helper. [#1314](https://github.com/yesodweb/yesod/pull/1314) + +## 1.5.3 + +* Added bodyNotContains [#1271](https://github.com/yesodweb/yesod/pull/1271) + +## 1.5.2 + +* Added assertEq, deprecated assertEqual [#1259](https://github.com/yesodweb/yesod/pull/1259) + ## 1.5.1.1 * Fix `addToken_` needing a trailing space and allows multiples spaces in css selector. - + ## 1.5.1.0 * Better error provenance for stuff invoking withResponse' [#1191](https://github.com/yesodweb/yesod/pull/1191) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.1.1/Yesod/Test/TransversingCSS.hs new/yesod-test-1.5.5/Yesod/Test/TransversingCSS.hs --- old/yesod-test-1.5.1.1/Yesod/Test/TransversingCSS.hs 2015-11-24 03:34:45.000000000 +0100 +++ new/yesod-test-1.5.5/Yesod/Test/TransversingCSS.hs 2017-02-05 13:38:01.000000000 +0100 @@ -59,8 +59,8 @@ -- * Right: List of matching Html fragments. findBySelector :: HtmlLBS -> Query -> Either String [String] findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x) - <$> (Right $ fromDocument $ HD.parseLBS html) - <*> parseQuery query + Control.Applicative.<$> (Right $ fromDocument $ HD.parseLBS html) + Control.Applicative.<*> parseQuery query -- Run a compiled query on Html, returning a list of matching Html fragments. runQuery :: Cursor -> [[SelectorGroup]] -> [Cursor] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.1.1/Yesod/Test.hs new/yesod-test-1.5.5/Yesod/Test.hs --- old/yesod-test-1.5.1.1/Yesod/Test.hs 2016-04-19 07:16:14.000000000 +0200 +++ new/yesod-test-1.5.5/Yesod/Test.hs 2017-02-05 13:38:01.000000000 +0100 @@ -4,6 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} + {-| Yesod.Test is a pragmatic framework for testing web applications built using wai and persistent. @@ -51,6 +52,7 @@ , post , postBody , followRedirect + , getLocation , request , addRequestHeader , setMethod @@ -84,11 +86,15 @@ -- * Assertions , assertEqual + , assertEqualNoShow + , assertEq + , assertHeader , assertNoHeader , statusIs , bodyEquals , bodyContains + , bodyNotContains , htmlAllContain , htmlAnyContain , htmlNoneContain @@ -126,6 +132,7 @@ import qualified Control.Monad.Trans.State as ST import Control.Monad.IO.Class import System.IO +import Yesod.Core.Unsafe (runFakeHandler) import Yesod.Test.TransversingCSS import Yesod.Core import qualified Data.Text.Lazy as TL @@ -139,6 +146,8 @@ import qualified Blaze.ByteString.Builder as Builder import Data.Time.Clock (getCurrentTime) import Control.Applicative ((<$>)) +import Text.Show.Pretty (ppShow) +import Data.Monoid (mempty) -- | The state used in a single test case defined using 'yit' -- @@ -315,8 +324,26 @@ htmlQuery = htmlQuery' yedResponse [] -- | Asserts that the two given values are equal. +-- +-- In case they are not equal, error mesasge includes the two values. +-- +-- @since 1.5.2 +assertEq :: (Eq a, Show a) => String -> a -> a -> YesodExample site () +assertEq m a b = + liftIO $ HUnit.assertBool msg (a == b) + where msg = "Assertion: " ++ m ++ "\n" ++ + "First argument: " ++ ppShow a ++ "\n" ++ + "Second argument: " ++ ppShow b ++ "\n" + +{-# DEPRECATED assertEqual "Use assertEq instead" #-} assertEqual :: (Eq a) => String -> a -> a -> YesodExample site () -assertEqual msg a b = liftIO $ HUnit.assertBool msg (a == b) +assertEqual = assertEqualNoShow + +-- | Asserts that the two given values are equal. +-- +-- @since 1.5.2 +assertEqualNoShow :: (Eq a) => String -> a -> a -> YesodExample site () +assertEqualNoShow msg a b = liftIO $ HUnit.assertBool msg (a == b) -- | Assert the last response status is as expected. statusIs :: Int -> YesodExample site () @@ -372,6 +399,14 @@ liftIO $ HUnit.assertBool ("Expected body to contain " ++ text) $ (simpleBody res) `contains` text +-- | Assert the last response doesn't have the given text. The check is performed using the response +-- body in full text form. +-- @since 1.5.3 +bodyNotContains :: String -> YesodExample site () +bodyNotContains text = withResponse $ \ res -> + liftIO $ HUnit.assertBool ("Expected body not to contain " ++ text) $ + not $ contains (simpleBody res) text + contains :: BSL8.ByteString -> String -> Bool contains a b = DL.isInfixOf b (TL.unpack $ decodeUtf8 a) @@ -644,7 +679,7 @@ getRequestCookies :: RequestBuilder site Cookies getRequestCookies = do requestBuilderData <- ST.get - headers <- case simpleHeaders <$> rbdResponse requestBuilderData of + headers <- case simpleHeaders Control.Applicative.<$> rbdResponse requestBuilderData of Just h -> return h Nothing -> failure "getRequestCookies: No request has been made yet; the cookies can't be looked up." @@ -717,6 +752,29 @@ Just h -> let url = TE.decodeUtf8 h in get url >> return (Right url) +-- | Parse the Location header of the last response. +-- +-- ==== __Examples__ +-- +-- > post ResourcesR +-- > (Right (ResourceR resourceId)) <- getLocation +-- +-- @since 1.5.4 +getLocation :: ParseRoute site => YesodExample site (Either T.Text (Route site)) +getLocation = do + mr <- getResponse + case mr of + Nothing -> return $ Left "getLocation called, but there was no previous response, so no Location header" + Just r -> case lookup "Location" (simpleHeaders r) of + Nothing -> return $ Left "getLocation called, but the previous response has no Location header" + Just h -> case parseRoute $ decodePath h of + Nothing -> return $ Left "getLocation called, but couldn’t parse it into a route" + Just l -> return $ Right l + where decodePath b = let (x, y) = BS8.break (=='?') b + in (H.decodePathSegments x, unJust <$> H.parseQueryText y) + unJust (a, Just b) = (a, b) + unJust (a, Nothing) = (a, Data.Monoid.mempty) + -- | Sets the HTTP method used by the request. -- -- ==== __Examples__ @@ -744,7 +802,7 @@ -> RequestBuilder site () setUrl url' = do site <- fmap rbdSite ST.get - eurl <- runFakeHandler + eurl <- Yesod.Core.Unsafe.runFakeHandler M.empty (const $ error "Yesod.Test: No logger available") site @@ -770,9 +828,7 @@ -- > import Data.Aeson -- > request $ do -- > setRequestBody $ encode $ object ["age" .= (1 :: Integer)] -setRequestBody :: (Yesod site) - => BSL8.ByteString - -> RequestBuilder site () +setRequestBody :: BSL8.ByteString -> RequestBuilder site () setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData body } -- | Adds the given header to the request; see "Network.HTTP.Types.Header" for creating 'Header's. @@ -800,8 +856,7 @@ -- > byLabel "First Name" "Felipe" -- > setMethod "PUT" -- > setUrl NameR -request :: Yesod site - => RequestBuilder site () +request :: RequestBuilder site () -> YesodExample site () request reqBuilder = do YesodExampleData app site oldCookies mRes <- ST.get diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.1.1/test/main.hs new/yesod-test-1.5.5/test/main.hs --- old/yesod-test-1.5.1.1/test/main.hs 2016-04-19 07:16:14.000000000 +0200 +++ new/yesod-test-1.5.5/test/main.hs 2017-02-05 13:38:01.000000000 +0100 @@ -5,6 +5,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main + ( main + -- avoid warnings + , resourcesRoutedApp + , Widget + ) where import Test.HUnit hiding (Test) import Test.Hspec @@ -21,16 +29,25 @@ import Network.Wai (pathInfo, requestHeaders) import Data.Maybe (fromMaybe) import Data.Either (isLeft, isRight) -import Control.Exception.Lifted(try, SomeException) import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415) +parseQuery_ :: Text -> [[SelectorGroup]] parseQuery_ = either error id . parseQuery + +findBySelector_ :: HtmlLBS -> Query -> [String] findBySelector_ x = either error id . findBySelector x -parseHtml_ = HD.parseLBS + +data RoutedApp = RoutedApp + +mkYesod "RoutedApp" [parseRoutes| +/ HomeR GET POST +/resources ResourcesR POST +/resources/#Text ResourceR GET +|] main :: IO () main = hspec $ do @@ -77,7 +94,7 @@ [NodeContent "Hello World"] ] ] - in parseHtml_ html @?= doc + in HD.parseLBS html @?= doc it "HTML" $ let html = "<html><head><title>foo</title></head><body><br><p>Hello World</p></body></html>" doc = Document (Prologue [] Nothing []) root [] @@ -92,7 +109,7 @@ [NodeContent "Hello World"] ] ] - in parseHtml_ html @?= doc + in HD.parseLBS html @?= doc describe "basic usage" $ yesodSpec app $ do ydescribe "tests1" $ do yit "tests1a" $ do @@ -209,7 +226,7 @@ statusIs 200 printBody bodyContains "Foo" - describe "CSRF with cookies/headers" $ yesodSpec CsrfApp $ do + describe "CSRF with cookies/headers" $ yesodSpec RoutedApp $ do yit "Should receive a CSRF cookie and add its value to the headers" $ do get ("/" :: Text) statusIs 200 @@ -251,6 +268,30 @@ r <- followRedirect liftIO $ assertBool "expected a Left when not a redirect" $ isLeft r + describe "route parsing in tests" $ yesodSpec RoutedApp $ do + yit "parses location header into a route" $ do + -- get CSRF token + get HomeR + statusIs 200 + + request $ do + setMethod "POST" + setUrl $ ResourcesR + addPostParam "foo" "bar" + addTokenFromCookie + statusIs 201 + + loc <- getLocation + liftIO $ assertBool "expected location to be available" $ isRight loc + let (Right (ResourceR t)) = loc + liftIO $ assertBool "expected location header to contain post param" $ t == "bar" + + yit "returns a Left when no redirect was returned" $ do + get HomeR + statusIs 200 + loc <- getLocation + liftIO $ assertBool "expected a Left when not a redirect" $ isLeft loc + instance RenderMessage LiteApp FormMessage where renderMessage _ _ = defaultFormMessage @@ -277,7 +318,7 @@ ((mfoo, widget), _) <- runFormPost $ renderDivs $ (,) - <$> areq textField "Some Label" Nothing + Control.Applicative.<$> areq textField "Some Label" Nothing <*> areq fileField "Some File" Nothing case mfoo of FormSuccess (foo, _) -> return $ toHtml foo @@ -304,16 +345,10 @@ onStatic "cookie" $ do onStatic "foo" $ dispatchTo $ do setMessage "Foo" - redirect ("/cookie/home" :: Text) + () <- redirect ("/cookie/home" :: Text) return () -data CsrfApp = CsrfApp - -mkYesod "CsrfApp" [parseRoutes| -/ HomeR GET POST -|] - -instance Yesod CsrfApp where +instance Yesod RoutedApp where yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware getHomeR :: Handler Html @@ -329,3 +364,15 @@ <p> Welcome to my test application. |] + +postResourcesR :: Handler () +postResourcesR = do + ([("foo", t)], _) <- runRequestBody + sendResponseCreated $ ResourceR t + +getResourceR :: Text -> Handler Html +getResourceR i = defaultLayout + [whamlet| + <p> + Read item #{i}. + |] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.1.1/yesod-test.cabal new/yesod-test-1.5.5/yesod-test.cabal --- old/yesod-test-1.5.1.1/yesod-test.cabal 2016-04-19 07:16:14.000000000 +0200 +++ new/yesod-test-1.5.5/yesod-test.cabal 2017-02-08 10:19:42.000000000 +0100 @@ -1,5 +1,5 @@ name: yesod-test -version: 1.5.1.1 +version: 1.5.5 license: MIT license-file: LICENSE author: Nubis <[email protected]> @@ -14,29 +14,30 @@ extra-source-files: README.md, LICENSE, test/main.hs, ChangeLog.md library - build-depends: base >= 4.3 && < 5 + build-depends: HUnit >= 1.2 , attoparsec >= 0.10 - , persistent >= 1.0 - , transformers >= 0.2.2 - , wai >= 3.0 - , wai-extra - , network >= 2.2 - , http-types >= 0.7 - , HUnit >= 1.2 - , hspec-core == 2.* + , base >= 4.3 && < 5 + , blaze-builder + , blaze-html >= 0.5 + , blaze-markup >= 0.5.1 , bytestring >= 0.9 , case-insensitive >= 0.2 - , text - , xml-conduit >= 1.0 - , xml-types >= 0.3 , containers + , cookie + , hspec-core == 2.* , html-conduit >= 0.1 - , blaze-html >= 0.5 - , blaze-markup >= 0.5.1 + , http-types >= 0.7 , monad-control + , network >= 2.2 + , persistent >= 1.0 + , pretty-show >= 1.6 + , text , time - , blaze-builder - , cookie + , transformers >= 0.2.2 + , wai >= 3.0 + , wai-extra + , xml-conduit >= 1.0 + , xml-types >= 0.3 , yesod-core >= 1.4.14 exposed-modules: Yesod.Test
