Refactor
This commit is contained in:
parent
bd86b4db7a
commit
6c2a20699a
@ -877,37 +877,10 @@ genericNameFromLabel match label = do
|
|||||||
case mres of
|
case mres of
|
||||||
Nothing -> failure "genericNameFromLabel: No response available"
|
Nothing -> failure "genericNameFromLabel: No response available"
|
||||||
Just res -> return res
|
Just res -> return res
|
||||||
let
|
let body = simpleBody res
|
||||||
body = simpleBody res
|
case genericNameFromHTML match label body of
|
||||||
mlabel = parseHTML body
|
Left e -> failure e
|
||||||
$// C.element "label"
|
Right x -> pure x
|
||||||
>=> isContentMatch label
|
|
||||||
mfor = mlabel >>= attribute "for"
|
|
||||||
|
|
||||||
isContentMatch x c
|
|
||||||
| x `match` 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
|
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- This looks up the name of a field based on a CSS selector and the contents of the label pointing to it.
|
-- This looks up the name of a field based on a CSS selector and the contents of the label pointing to it.
|
||||||
@ -925,6 +898,12 @@ genericNameFromSelectorLabel match selector label = do
|
|||||||
Right [] -> failure $ "genericNameFromSelectorLabel: No fragments match selector " <> selector
|
Right [] -> failure $ "genericNameFromSelectorLabel: No fragments match selector " <> selector
|
||||||
Right [matchingFragment] -> pure $ BSL8.pack matchingFragment
|
Right [matchingFragment] -> pure $ BSL8.pack matchingFragment
|
||||||
Right _matchingFragments -> failure $ "genericNameFromSelectorLabel: Multiple fragments match selector " <> selector
|
Right _matchingFragments -> failure $ "genericNameFromSelectorLabel: Multiple fragments match selector " <> selector
|
||||||
|
case genericNameFromHTML match label html of
|
||||||
|
Left e -> failure e
|
||||||
|
Right x -> pure x
|
||||||
|
|
||||||
|
genericNameFromHTML :: (T.Text -> T.Text -> Bool) -> T.Text -> HtmlLBS -> Either T.Text T.Text
|
||||||
|
genericNameFromHTML match label html =
|
||||||
let
|
let
|
||||||
parsedHTML = parseHTML html
|
parsedHTML = parseHTML html
|
||||||
mlabel = parsedHTML
|
mlabel = parsedHTML
|
||||||
@ -936,26 +915,26 @@ genericNameFromSelectorLabel match selector label = do
|
|||||||
| x `match` T.concat (c $// content) = [c]
|
| x `match` T.concat (c $// content) = [c]
|
||||||
| otherwise = []
|
| otherwise = []
|
||||||
|
|
||||||
case mfor of
|
in case mfor of
|
||||||
for:[] -> do
|
for:[] -> do
|
||||||
let mname = parsedHTML
|
let mname = parsedHTML
|
||||||
$// attributeIs "id" for
|
$// attributeIs "id" for
|
||||||
>=> attribute "name"
|
>=> attribute "name"
|
||||||
case mname of
|
case mname of
|
||||||
"":_ -> failure $ T.concat
|
"":_ -> Left $ T.concat
|
||||||
[ "Label "
|
[ "Label "
|
||||||
, label
|
, label
|
||||||
, " resolved to id "
|
, " resolved to id "
|
||||||
, for
|
, for
|
||||||
, " which was not found. "
|
, " which was not found. "
|
||||||
]
|
]
|
||||||
name:_ -> return name
|
name:_ -> Right name
|
||||||
[] -> failure $ "No input with id " <> for
|
[] -> Left $ "No input with id " <> for
|
||||||
[] ->
|
[] ->
|
||||||
case filter (/= "") $ mlabel >>= (child >=> C.element "input" >=> attribute "name") of
|
case filter (/= "") $ mlabel >>= (child >=> C.element "input" >=> attribute "name") of
|
||||||
[] -> failure $ "No label contained: " <> label
|
[] -> Left $ "No label contained: " <> label
|
||||||
name:_ -> return name
|
name:_ -> Right name
|
||||||
_ -> failure $ "More than one label contained " <> label
|
_ -> Left $ "More than one label contained " <> label
|
||||||
|
|
||||||
byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains)
|
byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains)
|
||||||
-> T.Text -- ^ The text contained in the @\<label>@.
|
-> T.Text -- ^ The text contained in the @\<label>@.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user