haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Minor yesod-test fixes

Browse Source
This commit is contained in:
Michael Snoyman 2012-08-03 11:31:35 +03:00
parent f80a810df9
commit bc8e4b0588
2 changed files with 8 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
yesod-test/Yesod/Test.hs
View File

@ -89,6 +89,7 @@ import Data.Monoid (mappend)
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
import Text.XML.Cursor hiding (element) import Text.XML.Cursor hiding (element)
import qualified Text.XML.Cursor as C
import qualified Text.HTML.DOM as HD import qualified Text.HTML.DOM as HD
-- | The state used in 'describe' to build a list of specs -- | The state used in 'describe' to build a list of specs
@ -165,8 +166,8 @@ withResponse f = maybe err f =<< fmap readResponse ST.get
-- | Use HXT to parse a value from an html tag. -- | Use HXT to parse a value from an html tag.
-- Check for usage examples in this module's source. -- Check for usage examples in this module's source.
parseHTML :: Html -> (Cursor -> [a]) -> [a] parseHTML :: Html -> Cursor
parseHTML html p = p $ fromDocument $ HD.parseLBS html parseHTML html = fromDocument $ HD.parseLBS html
-- | Query the last response using css selectors, returns a list of matched fragments -- | Query the last response using css selectors, returns a list of matched fragments
htmlQuery :: HoldsResponse a => Query -> ST.StateT a IO [Html] htmlQuery :: HoldsResponse a => Query -> ST.StateT a IO [Html]
@ -285,10 +286,9 @@ nameFromLabel :: T.Text -> RequestBuilder T.Text
nameFromLabel label = withResponse $ \ res -> do nameFromLabel label = withResponse $ \ res -> do
let let
body = simpleBody res body = simpleBody res
escaped = escapeHtmlEntities label mfor = parseHTML body
mfor = parseHTML body $ \c -> c $// C.element "label"
$// attributeIs "name" "label" >=> contentContains label
>=> contentContains escaped
>=> attribute "for" >=> attribute "for"
contentContains x c contentContains x c
@ -297,7 +297,7 @@ nameFromLabel label = withResponse $ \ res -> do
case mfor of case mfor of
for:[] -> do for:[] -> do
let mname = parseHTML body $ \c -> c let mname = parseHTML body
$// attributeIs "id" for $// attributeIs "id" for
>=> attribute "name" >=> attribute "name"
case mname of case mname of
@ -346,7 +346,7 @@ addNonce_ scope = do
matches <- htmlQuery $ scope `mappend` "input[name=_token][type=hidden][value]" matches <- htmlQuery $ scope `mappend` "input[name=_token][type=hidden][value]"
case matches of case matches of
[] -> failure $ "No nonce found in the current page" [] -> failure $ "No nonce found in the current page"
element:[] -> byName "_token" $ head $ parseHTML element $ attribute "value" element:[] -> byName "_token" $ head $ attribute "value" $ parseHTML element
_ -> failure $ "More than one nonce found in the page" _ -> failure $ "More than one nonce found in the page"
-- | For responses that display a single form, just lookup the only nonce available. -- | For responses that display a single form, just lookup the only nonce available.

5
yesod-test/Yesod/Test/TransversingCSS.hs
View File

@ -46,13 +46,8 @@ import Text.XML
import Text.XML.Cursor import Text.XML.Cursor
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Text.HTML.DOM as HD import qualified Text.HTML.DOM as HD
#if MIN_VERSION_blaze_html(0, 5, 0)
import Text.Blaze.Html (toHtml) import Text.Blaze.Html (toHtml)
import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Blaze.Html.Renderer.String (renderHtml)
#else
import Text.Blaze (toHtml)
import Text.Blaze.Renderer.String (renderHtml)
#endif
type Query = T.Text type Query = T.Text
type Html = L.ByteString type Html = L.ByteString