yesod-test 0.2.1 → 0.3.0

raw patch · 6 files changed

+117/−138 lines, 6 filesdep +monad-controldep +pool-conduitdep −hxtdep −xml2htmldep ~blaze-htmldep ~hspecdep ~html-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control, pool-conduit

Dependencies removed: hxt, xml2html

Dependency ranges changed: blaze-html, hspec, html-conduit, http-types, persistent, wai, wai-test, xml-conduit

API changes (from Hackage documentation)

Files

• README.md +6/−5
• Yesod/Test.hs +80/−67
• Yesod/Test/HtmlParse.hs +0/−14
• Yesod/Test/TransversingCSS.hs +2/−8
• test/main.hs +15/−20
• yesod-test.cabal +14/−24

@@ -1,11 +1,12 @@-# TestWaiPersistent - Pragmatic integration tests for haskell web applications using WAI and Persistent
+# yesod-test
 
-yesod-test is designed for testing web applications built using wai and persistent.
+Pragmatic integration tests for haskell web applications using WAI and optionally a database (Persistent).
+
 It's main goal is to encourage integration and system testing of web applications by making everything /easy to test/. 
 
 Your tests are like browser sessions that keep track of cookies and the last
-visited page. You can perform assertions on the content of HTML responses,
-using css selectors to explore the document more easily.
+visited page. You can perform assertions on the content of HTML responses
+using css selectors.
 
 You can also easily build requests using forms present in the current page.
 This is very useful for testing web applications built in yesod for example,
@@ -15,7 +16,7 @@ Your database is also directly available so you can use runDB to set up
 backend pre-conditions, or to assert that your session is having the desired effect.
 
-The testing facilities behind the scenes are HUnit and HSpec.
+The testing facilities behind the scenes are HSpec (on top of HUnit).
 
 This is the helloworld and kitchen sink. In this case for testing a yesod app.
 

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-| Yesod.Test is a pragmatic framework for testing web applications built using wai and persistent.@@ -16,14 +17,14 @@ were your forms may have field names generated by the framework or a randomly generated '_nonce' field. -Your database is also directly available so you can use runDB to set up+Your database is also directly available so you can use runDBRunner to set up backend pre-conditions, or to assert that your session is having the desired effect.  -}  module Yesod.Test (   -- * Declaring and running your test suite-  runTests, describe, it, Specs, OneSpec,+  runTests, describe, it, SpecsConn, OneSpec,    -- * Making requests   -- | To make a request you need to point to an url and pass in some parameters.@@ -47,7 +48,7 @@   addNonce, addNonce_,    -- * Running database queries-  runDB,+  runDBRunner,    -- * Assertions   assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains,@@ -69,6 +70,7 @@ import qualified Data.List as DL import qualified Data.Maybe as DY import qualified Data.ByteString.Char8 as BS8+import Data.ByteString (ByteString) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy.Char8 as BSL8@@ -77,36 +79,41 @@ import qualified Network.HTTP.Types as H import qualified Network.Socket.Internal as Sock import Data.CaseInsensitive (CI)-import Text.XML.HXT.Core hiding (app, err) import Network.Wai import Network.Wai.Test hiding (assertHeader, assertNoHeader) import qualified Control.Monad.Trans.State as ST import Control.Monad.IO.Class import System.IO import Yesod.Test.TransversingCSS-import Database.Persist.GenericSql import Data.Monoid (mappend) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)+import Text.XML.Cursor hiding (element)+import qualified Text.XML.Cursor as C+import qualified Text.HTML.DOM as HD+import Data.Conduit.Pool (Pool)+import Control.Monad.Trans.Control (MonadBaseControl)  -- | The state used in 'describe' to build a list of specs-data SpecsData = SpecsData Application ConnectionPool [Core.Spec]+data SpecsData conn = SpecsData Application (Pool conn) [Core.Spec]  -- | The specs state monad is where 'describe' runs.-type Specs = ST.StateT SpecsData IO ()+-- parameterized by a database connection.+-- You should create type Specs = SpecsConn MyDBConnection+type SpecsConn conn = ST.StateT (SpecsData conn) IO ()  -- | The state used in a single test case defined using 'it'-data OneSpecData = OneSpecData Application ConnectionPool CookieValue (Maybe SResponse)+data OneSpecData conn = OneSpecData Application (Pool conn) CookieValue (Maybe SResponse)  -- | The OneSpec state monad is where 'it' runs.-type OneSpec = ST.StateT OneSpecData IO+type OneSpec conn = ST.StateT (OneSpecData conn) IO  data RequestBuilderData = RequestBuilderData [RequestPart] (Maybe SResponse)  -- | Request parts let us discern regular key/values from files sent in the request. data RequestPart-  = ReqPlainPart String String-  | ReqFilePart String FilePath BSL8.ByteString String+  = ReqPlainPart T.Text T.Text+  | ReqFilePart T.Text FilePath BSL8.ByteString T.Text  -- | The RequestBuilder state monad constructs an url encoded string of arguments -- to send with your requests. Some of the functions that run on it use the current@@ -118,12 +125,12 @@ -- the last received response. class HoldsResponse a where   readResponse :: a -> Maybe SResponse-instance HoldsResponse OneSpecData where+instance HoldsResponse (OneSpecData conn) where   readResponse (OneSpecData _ _ _ x) = x instance HoldsResponse RequestBuilderData where   readResponse (RequestBuilderData _ x) = x   -type CookieValue = H.Ascii+type CookieValue = ByteString  -- | Runs your test suite, using you wai 'Application' and 'ConnectionPool' for performing  -- the database queries in your tests.@@ -133,21 +140,21 @@ --  -- Look at the examples directory on this package to get an idea of the (small) amount of -- boilerplate code you'll need to write before calling this.-runTests :: Application -> ConnectionPool -> Specs -> IO a+runTests :: Application -> Pool conn -> SpecsConn conn -> IO () runTests app connection specsDef = do   (SpecsData _ _ specs) <- ST.execStateT specsDef (SpecsData app connection [])-  Runner.hspecX specs+  Runner.hspec specs  -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application' -- and 'ConnectionPool'-describe :: String -> Specs -> Specs+describe :: String -> SpecsConn conn -> SpecsConn conn describe label action = do   sData <- ST.get   SpecsData app conn specs <- liftIO $ ST.execStateT action sData   ST.put $ SpecsData app conn [Core.describe label specs]  -- | Describe a single test that keeps cookies, and a reference to the last response.-it :: String -> OneSpec () -> Specs+it :: String -> OneSpec conn () -> SpecsConn conn it label action = do   SpecsData app conn specs <- ST.get   let spec = Core.it label $ do@@ -163,18 +170,18 @@  -- | Use HXT to parse a value from an html tag. -- Check for usage examples in this module's source.-parseHTML :: Html -> LA XmlTree a -> [a]-parseHTML html p = runLA (hread >>> p ) (TL.unpack $ decodeUtf8 html)+parseHTML :: Html -> Cursor+parseHTML html = fromDocument $ HD.parseLBS html  -- | Query the last response using css selectors, returns a list of matched fragments htmlQuery :: HoldsResponse a => Query -> ST.StateT a IO [Html] htmlQuery query = withResponse $ \ res ->   case findBySelector (simpleBody res) query of-    Left err -> failure $ T.unpack query ++ " did not parse: " ++ (show err)+    Left err -> failure $ query <> " did not parse: " <> T.pack (show err)     Right matches -> return $ map (encodeUtf8 . TL.pack) matches  -- | Asserts that the two given values are equal.-assertEqual :: (Eq a) => String -> a -> a -> OneSpec ()+assertEqual :: (Eq a) => String -> a -> a -> OneSpec conn () assertEqual msg a b = liftIO $ HUnit.assertBool msg (a == b)  -- | Assert the last response status is as expected.@@ -189,7 +196,7 @@ assertHeader :: HoldsResponse a => CI BS8.ByteString -> BS8.ByteString -> ST.StateT a IO () assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->   case lookup header h of-    Nothing -> failure $ concat+    Nothing -> failure $ T.pack $ concat         [ "Expected header "         , show header         , " to be "@@ -210,7 +217,7 @@ assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->   case lookup header h of     Nothing -> return ()-    Just s  -> failure $ concat+    Just s  -> failure $ T.pack $ concat         [ "Unexpected header "         , show header         , " containing "@@ -240,7 +247,7 @@ htmlAllContain query search = do   matches <- htmlQuery query   case matches of-    [] -> failure $ "Nothing matched css query: "++T.unpack query+    [] -> failure $ "Nothing matched css query: " <> query     _ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search) $           DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) @@ -264,7 +271,7 @@   liftIO $ hPutStrLn stderr $ show matches  -- | Add a parameter with the given name and value.-byName :: String -> String -> RequestBuilder ()+byName :: T.Text -> T.Text -> RequestBuilder () byName name value = do   RequestBuilderData parts r <- ST.get   ST.put $ RequestBuilderData ((ReqPlainPart name value):parts) r@@ -272,50 +279,53 @@ -- | Add a file to be posted with the current request -- -- Adding a file will automatically change your request content-type to be multipart/form-data-fileByName :: String -> FilePath -> String -> RequestBuilder ()+fileByName :: T.Text -> FilePath -> T.Text -> RequestBuilder () fileByName name path mimetype = do   RequestBuilderData parts r <- ST.get   contents <- liftIO $ BSL8.readFile path   ST.put $ RequestBuilderData ((ReqFilePart name path contents mimetype):parts) r  -- This looks up the name of a field based on the contents of the label pointing to it.-nameFromLabel :: String -> RequestBuilder String+nameFromLabel :: T.Text -> RequestBuilder T.Text nameFromLabel label = withResponse $ \ res -> do   let     body = simpleBody res-    escaped = escapeHtmlEntities label-    mfor = parseHTML body $ deep $ hasName "label"-        >>> filterA (xshow this >>> mkText >>> hasText (DL.isInfixOf escaped))-        >>> getAttrValue "for"+    mfor = parseHTML body+                $// C.element "label"+                >=> contentContains label+                >=> attribute "for" +    contentContains x c+        | x `T.isInfixOf` T.concat (c $// content) = [c]+        | otherwise = []+   case mfor of     for:[] -> do-      let mname = parseHTML body $ deep $ hasAttrValue "id" (==for) >>> getAttrValue "name"+      let mname = parseHTML body+                    $// attributeIs "id" for+                    >=> attribute "name"       case mname of-        "":_ -> failure $ "Label "++label++" resolved to id "++for++" which was not found. "+        "":_ -> failure $ T.concat+            [ "Label "+            , label+            , " resolved to id "+            , for+            , " which was not found. "+            ]         name:_ -> return name-        _ -> failure $ "More than one input with id " ++ for-    [] -> failure $ "No label contained: "++label-    _ -> failure $ "More than one label contained "++label+        _ -> failure $ "More than one input with id " <> for+    [] -> failure $ "No label contained: " <> label+    _ -> failure $ "More than one label contained " <> label --- | Escape HTML entities in a string, so you can write the text you want in--- label lookups without worrying about the fact that yesod escapes some characters.-escapeHtmlEntities :: String -> String -escapeHtmlEntities "" = ""-escapeHtmlEntities (c:cs) = case c of-  '<'  -> '&' : 'l' : 't' : ';'             : escapeHtmlEntities cs-  '>'  -> '&' : 'g' : 't' : ';'             : escapeHtmlEntities cs-  '&'  -> '&' : 'a' : 'm' : 'p' : ';'       : escapeHtmlEntities cs-  '"'  -> '&' : 'q' : 'u' : 'o' : 't' : ';' : escapeHtmlEntities cs-  '\'' -> '&' : '#' : '3' : '9' : ';'       : escapeHtmlEntities cs-  x    -> x                                 : escapeHtmlEntities cs+(<>) :: T.Text -> T.Text -> T.Text+(<>) = T.append -byLabel :: String -> String -> RequestBuilder ()+byLabel :: T.Text -> T.Text -> RequestBuilder () byLabel label value = do   name <- nameFromLabel label   byName name value -fileByLabel :: String -> FilePath -> String -> RequestBuilder ()+fileByLabel :: T.Text -> FilePath -> T.Text -> RequestBuilder () fileByLabel label path mime = do   name <- nameFromLabel label   fileByName name path mime@@ -327,7 +337,7 @@   matches <- htmlQuery $ scope `mappend` "input[name=_token][type=hidden][value]"   case matches of     [] -> failure $ "No nonce found in the current page"-    element:[] -> byName "_token" $ head $ parseHTML element $ getAttrValue "value"+    element:[] -> byName "_token" $ head $ attribute "value" $ parseHTML element     _ -> failure $ "More than one nonce found in the page"  -- | For responses that display a single form, just lookup the only nonce available.@@ -335,24 +345,24 @@ addNonce = addNonce_ ""  -- | Perform a POST request to url, using params-post :: BS8.ByteString -> RequestBuilder () -> OneSpec ()+post :: BS8.ByteString -> RequestBuilder () -> OneSpec conn () post url paramsBuild = do   doRequest "POST" url paramsBuild  -- | Perform a POST request without params-post_ :: BS8.ByteString -> OneSpec ()+post_ :: BS8.ByteString -> OneSpec conn () post_ = flip post $ return ()   -- | Perform a GET request to url, using params-get :: BS8.ByteString -> RequestBuilder () -> OneSpec ()+get :: BS8.ByteString -> RequestBuilder () -> OneSpec conn () get url paramsBuild = doRequest "GET" url paramsBuild  -- | Perform a GET request without params-get_ :: BS8.ByteString -> OneSpec ()+get_ :: BS8.ByteString -> OneSpec conn () get_ = flip get $ return ()  -- | General interface to performing requests, letting you specify the request method and extra headers.-doRequest :: H.Method -> BS8.ByteString -> RequestBuilder a -> OneSpec ()+doRequest :: H.Method -> BS8.ByteString -> RequestBuilder a -> OneSpec conn () doRequest method url paramsBuild = do   OneSpecData app conn cookie mRes <- ST.get   RequestBuilderData parts _ <- liftIO $ ST.execStateT paramsBuild $ RequestBuilderData [] mRes@@ -379,22 +389,22 @@     BS8.concat $ separator : [BS8.concat [multipartPart p, separator] | p <- parts]   multipartPart (ReqPlainPart k v) = BS8.concat     [ "Content-Disposition: form-data; "-    , "name=\"", (BS8.pack k), "\"\r\n\r\n"-    , (BS8.pack v), "\r\n"]+    , "name=\"", TE.encodeUtf8 k, "\"\r\n\r\n"+    , TE.encodeUtf8 v, "\r\n"]   multipartPart (ReqFilePart k v bytes mime) = BS8.concat     [ "Content-Disposition: form-data; "-    , "name=\"", BS8.pack k, "\"; "+    , "name=\"", TE.encodeUtf8 k, "\"; "     , "filename=\"", BS8.pack v, "\"\r\n"-    , "Content-Type: ", BS8.pack mime, "\r\n\r\n"+    , "Content-Type: ", TE.encodeUtf8 mime, "\r\n\r\n"     , BS8.concat $ BSL8.toChunks bytes, "\r\n"]    -- For building the regular non-multipart requests   makeSinglepart cookie parts = SRequest (mkRequest      [("Cookie",cookie), ("Content-Type", "application/x-www-form-urlencoded")]) $-    BSL8.pack $ DL.concat $ DL.intersperse "&" $ map singlepartPart parts+    BSL8.fromChunks $ return $ TE.encodeUtf8 $ T.intercalate "&" $ map singlepartPart parts    singlepartPart (ReqFilePart _ _ _ _) = ""-  singlepartPart (ReqPlainPart k v) = concat [k,"=",v]+  singlepartPart (ReqPlainPart k v) = T.concat [k,"=",v]    -- General request making    mkRequest headers = defaultRequest@@ -407,11 +417,14 @@    -- | Run a persistent db query. For asserting on the results of performed actions -- or setting up pre-conditions. At the moment this part is still very raw.-runDB :: SqlPersist IO a -> OneSpec a-runDB query = do+--+-- It is intended that you parametize the first argument of this function for your backend+-- runDB = runDBRunnder SqlPersist+runDBRunner :: (MonadBaseControl IO m, MonadIO m) => (poolrunner m a -> Pool conn -> IO a) -> poolrunner m a -> OneSpec conn a+runDBRunner poolRunner query = do   OneSpecData _ pool _ _ <- ST.get-  liftIO $ runSqlPool query pool+  liftIO $ poolRunner query pool  -- Yes, just a shortcut-failure :: (MonadIO a) => String -> a b-failure reason = (liftIO $ HUnit.assertFailure reason) >> error ""+failure :: (MonadIO a) => T.Text -> a b+failure reason = (liftIO $ HUnit.assertFailure $ T.unpack reason) >> error ""

@@ -1,14 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Parse an HTML document into xml-conduit's Document.------ Assumes UTF-8 encoding.-module Yesod.Test.HtmlParse-    ( parseHtml-    ) where--import qualified Data.ByteString.Lazy as L-import Text.XML (Document)-import qualified Text.HTML.DOM as HD--parseHtml :: L.ByteString -> Either String Document-parseHtml = Right . HD.parseLBS

@@ -41,19 +41,13 @@  import Yesod.Test.CssQuery import qualified Data.Text as T-import Yesod.Test.HtmlParse (parseHtml) import Control.Applicative ((<$>), (<*>)) import Text.XML import Text.XML.Cursor import qualified Data.ByteString.Lazy as L-#if MIN_VERSION_blaze_html(0, 5, 0)+import qualified Text.HTML.DOM as HD import Text.Blaze.Html (toHtml) import Text.Blaze.Html.Renderer.String (renderHtml)-#else-import Text.Blaze (toHtml)-import Text.Blaze.Renderer.String (renderHtml)-#endif-import Text.XML.Xml2Html ()  type Query = T.Text type Html = L.ByteString@@ -65,7 +59,7 @@ -- * Right: List of matching Html fragments. findBySelector :: Html -> Query -> Either String [String] findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x)-    <$> (fromDocument <$> parseHtml html)+    <$> (Right $ fromDocument $ HD.parseLBS html)     <*> parseQuery query  -- Run a compiled query on Html, returning a list of matching Html fragments.

@@ -6,23 +6,18 @@  import Yesod.Test.CssQuery import Yesod.Test.TransversingCSS-import Yesod.Test.HtmlParse import Text.XML  import Data.ByteString.Lazy.Char8 ()+import qualified Data.Map as Map+import qualified Text.HTML.DOM as HD  parseQuery_ = either error id . parseQuery findBySelector_ x = either error id . findBySelector x-parseHtml_ = either error id . parseHtml+parseHtml_ = HD.parseLBS  main :: IO ()-main =-#if MIN_VERSION_hspec(1,2,0)-  hspec-#else-  hspecX-#endif-   $ do+main = hspec $ do     describe "CSS selector parsing" $ do         it "elements" $ parseQuery_ "strong" @?= [[DeepChildren [ByTagName "strong"]]]         it "child elements" $ parseQuery_ "strong > i" @?= [[DeepChildren [ByTagName "strong"], DirectChildren [ByTagName "i"]]]@@ -40,13 +35,13 @@         it "XHTML" $             let html = "<html><head><title>foo</title></head><body><p>Hello World</p></body></html>"                 doc = Document (Prologue [] Nothing []) root []-                root = Element "html" []-                    [ NodeElement $ Element "head" []-                        [ NodeElement $ Element "title" []+                root = Element "html" Map.empty+                    [ NodeElement $ Element "head" Map.empty+                        [ NodeElement $ Element "title" Map.empty                             [NodeContent "foo"]                         ]-                    , NodeElement $ Element "body" []-                        [ NodeElement $ Element "p" []+                    , NodeElement $ Element "body" Map.empty+                        [ NodeElement $ Element "p" Map.empty                             [NodeContent "Hello World"]                         ]                     ]@@ -54,14 +49,14 @@         it "HTML" $             let html = "<html><head><title>foo</title></head><body><br><p>Hello World</p></body></html>"                 doc = Document (Prologue [] Nothing []) root []-                root = Element "html" []-                    [ NodeElement $ Element "head" []-                        [ NodeElement $ Element "title" []+                root = Element "html" Map.empty+                    [ NodeElement $ Element "head" Map.empty+                        [ NodeElement $ Element "title" Map.empty                             [NodeContent "foo"]                         ]-                    , NodeElement $ Element "body" []-                        [ NodeElement $ Element "br" [] []-                        , NodeElement $ Element "p" []+                    , NodeElement $ Element "body" Map.empty+                        [ NodeElement $ Element "br" Map.empty []+                        , NodeElement $ Element "p" Map.empty                             [NodeContent "Hello World"]                         ]                     ]

@@ -1,5 +1,5 @@ name:               yesod-test-version:            0.2.1+version:            0.3.0 license:            MIT license-file:       LICENSE author:             Nubis <nubis@woobiz.com.ar>@@ -13,44 +13,32 @@ description:        Behaviour Oriented integration Testing for Yesod Applications  extra-source-files: README.md, LICENSE, test/main.hs -flag blaze_html_0_5-    description: use blaze-html 0.5 and blaze-markup 0.5-    default: True-- library     build-depends:   base                      >= 4.3      && < 5-                   , hxt                       >= 9.1.6                    , attoparsec                >= 0.10     && < 0.11-                   , persistent                >= 0.9      && < 0.10+                   , persistent                >= 1.0      && < 1.1                    , transformers              >= 0.2.2    && < 0.4-                   , wai                       >= 1.2      && < 1.3-                   , wai-test                  >= 1.2      && < 1.3+                   , wai                       >= 1.3      && < 1.4+                   , wai-test                  >= 1.3      && < 1.4                    , network                   >= 2.2      && < 2.4-                   , http-types                >= 0.6      && < 0.7+                   , http-types                >= 0.7      && < 0.8                    , HUnit                     >= 1.2      && < 1.3-                   , hspec                     >= 1.1      && < 1.3+                   , hspec                     >= 1.3      && < 1.4                    , bytestring                >= 0.9                    , case-insensitive          >= 0.2                    , text-                   , xml-conduit               >= 0.7      && < 0.8+                   , xml-conduit               >= 1.0      && < 1.1                    , xml-types                 >= 0.3      && < 0.4                    , containers-                   , xml2html                  >= 0.1.2.3  && < 0.2-                   , html-conduit              >= 0.0.1    && < 0.1--    if flag(blaze_html_0_5)-        build-depends:-                     blaze-html               >= 0.5     && < 0.6-                   , blaze-markup             >= 0.5.1   && < 0.6-    else-        build-depends:-                     blaze-html               >= 0.4     && < 0.5+                   , html-conduit              >= 0.1      && < 0.2+                   , blaze-html                >= 0.5      && < 0.6+                   , blaze-markup              >= 0.5.1    && < 0.6+                   , pool-conduit+                   , monad-control      exposed-modules: Yesod.Test                      Yesod.Test.CssQuery                      Yesod.Test.TransversingCSS-                     Yesod.Test.HtmlParse     ghc-options:  -Wall  test-suite test@@ -63,6 +51,8 @@                           , HUnit                           , xml-conduit                           , bytestring+                          , containers+                          , html-conduit  source-repository head   type: git