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 - psimons@suse.com
+
+- Update to version 1.5.5 with cabal2obs.
+
+-------------------------------------------------------------------
+Fri Dec 16 18:00:11 UTC 2016 - psimons@suse.com
+
+- Update to version 1.5.4.1 with cabal2obs.
+
+-------------------------------------------------------------------
+Sun Dec 4 19:48:14 UTC 2016 - psimons@suse.com
+
+- Update to version 1.5.4 with cabal2obs.
+
+-------------------------------------------------------------------
+Thu Sep 15 06:32:51 UTC 2016 - psimons@suse.com
+
+- Update to version 1.5.3 revision 0 with cabal2obs.
+
+-------------------------------------------------------------------
+Wed Aug 17 18:43:36 UTC 2016 - psimons@suse.com
+
+- 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