diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index e359896b..e736ddd3 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -73,6 +73,7 @@ module Yesod.Test
-- These functions let you add parameters to your request based
-- on currently displayed label names.
, byLabel
+ , byLabelExact
, fileByLabel
-- *** CSRF Tokens
@@ -563,6 +564,46 @@ nameFromLabel label = do
name:_ -> return name
_ -> failure $ "More than one label contained " <> label
+-- This looks up the name of a field based on the contents of the label pointing to it (exact).
+nameFromLabelExact :: T.Text -> RequestBuilder site T.Text
+nameFromLabelExact label = do
+ mres <- fmap rbdResponse ST.get
+ res <-
+ case mres of
+ Nothing -> failure "nameFromLabel: No response available"
+ Just res -> return res
+ let
+ body = simpleBody res
+ mlabel = parseHTML body
+ $// C.element "label"
+ >=> contentIs label
+ mfor = mlabel >>= attribute "for"
+
+ contentIs x c
+ | x == T.concat (c $// content) = [c]
+ | otherwise = []
+
+ case mfor of
+ for:[] -> do
+ let mname = parseHTML body
+ $// attributeIs "id" for
+ >=> attribute "name"
+ case mname of
+ "":_ -> failure $ T.concat
+ [ "Label "
+ , label
+ , " resolved to id "
+ , for
+ , " which was not found. "
+ ]
+ name:_ -> return name
+ [] -> failure $ "No input with id " <> for
+ [] ->
+ case filter (/= "") $ mlabel >>= (child >=> C.element "input" >=> attribute "name") of
+ [] -> failure $ "No label contained: " <> label
+ name:_ -> return name
+ _ -> failure $ "More than one label contained " <> label
+
(<>) :: T.Text -> T.Text -> T.Text
(<>) = T.append
@@ -598,6 +639,38 @@ byLabel label value = do
name <- nameFromLabel label
addPostParam name value
+-- How does this work for the alternate syntax?
+
+-- | Finds the @\