4 files changed, 73 insertions(+), 5 deletions(-)

M amphiarao.cabal
M src/Internal.hs
A src/Internal/Forms.hs
M src/Internal/Load.hs

@@ 55,7 55,7 @@ executable amphiarao
   
   -- Modules included in this executable, other than Main.
   other-modules:       Webdriver, Capabilities, JSON, Messages,
-        Internal, Internal.Load, Internal.Elements,
+        Internal, Internal.Load, Internal.Elements, Internal.Forms,
         Internal.Elements.XPath, Internal.Elements.XPathParse,
         UI.Templates, UI.Search,
         XML.Selectors.CSS, XML.Selectors.CSS.Parse, XML.Selectors.CSS.Tokens, XML.Selectors.CSS.Types

@@ 31,7 31,9 @@ data Session' = Session {
     backStack :: [URI.URI],
     nextStack :: [URI.URI],
     document :: XML.Document,
-    knownEls :: M.HashMap UUID XML.Cursor
+    knownEls :: M.HashMap UUID XML.Cursor,
+    forms :: M.HashMap XML.Element (M.HashMap Text [Text]),
+    id2els :: M.HashMap Text XML.Cursor
   }
 
 initSessions :: IO Sessions


@@ 58,7 60,9 @@ createSession sessions caps = do
             },
             XML.documentEpilogue = []
         },
-        knownEls = M.empty
+        knownEls = M.empty,
+        forms = M.empty,
+        id2els = M.empty
       }
     session' <- newMVar session
     modifyMVar_ sessions (return . M.insert uuid session')

@@ 0,0 1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Internal.Forms(findForm, prefillForm) where
+
+import Text.XML
+import Text.XML.Cursor
+import qualified Data.Map as M
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Text as Txt
+
+import Data.Maybe
+
+findForm cursor id2els
+    | Just (NodeElement el@(Element (Name "form" _ _) _ _)) <- node cursor = el
+    | Just (NodeElement el) <- node cursor, Just el' <- findForm' el id2els = el'
+    | (form:_) <- parent cursor = findForm form id2els -- Propagate id2els for the sake of event dispatch.
+    | otherwise = Element "fail" M.empty [] -- Tombstone value
+
+findForm' (Element (Name name _ _) attrs _) id2els
+    | name == "label", Just for <- "for" `M.lookup` attrs',
+            Just input <- for `M.lookup` id2els = Just $ findForm input id2els
+    | Just form <- "form" `M.lookup` attrs', Just cursor <- form `M.lookup` id2els,
+        Just (NodeElement ret) <- node cursor = Just ret
+    | otherwise = Nothing
+  where attrs' = M.mapKeys nameLocalName attrs
+
+prefillForm (Element (Name "form" _ _) attrs children) root = HM.fromListWith (++) (
+    (prefillForm' $ map node $ (descendant >=> checkElement isForForm) root) ++
+    prefillForm' children)
+  where
+    isForForm (Element _ attrs' _) | Just id <- "id" `M.lookup` M.mapKeys nameLocalName attrs,
+        Just form <- "form" `M.lookup` M.mapKeys nameLocalName attrs' = id == form
+    isForForm _ = False
+
+prefillForm' (NodeElement (Element (Name "input" _ _) attrs _):nodes)
+    | Just type_ <- "type" `M.lookup` attrs', Just name <- "name" `M.lookup` attrs', Just value <- "value" `M.lookup` attrs',
+            type_ `notElem` ["radio", "checkbox", "reset", "submit", "button"] || "checked" `M.member` attrs' =
+        (name, [value]):prefillForm' nodes
+    | otherwise = prefillForm' nodes
+  where attrs' = M.mapKeys nameLocalName attrs
+prefillForm' (NodeElement (Element (Name "select" _ _) attrs childs):nodes)
+    | Just name <- "name" `M.lookup` attrs' =
+        case [value | NodeElement (Element _ attrs2 _) <- childs,
+                value <- maybeToList $ M.lookup "value" $ M.mapKeys nameLocalName attrs2] of
+            [] -> prefillForm' nodes
+            values | "multiple" `M.member` attrs' -> (name, values):prefillForm' nodes
+            (value:_) -> (name, [value]):prefillForm' nodes
+    | otherwise = prefillForm' nodes
+  where attrs' = M.mapKeys nameLocalName attrs
+prefillForm' (NodeElement (Element (Name "textarea" _ _) attrs childs):nodes)
+    | Just name <- "name" `M.lookup` attrs =
+        (name, [Txt.concat [value | NodeContent value <- childs]]):prefillForm' nodes
+    | otherwise = prefillForm' nodes
+

@@ 13,7 13,7 @@ import qualified Data.Text as Txt
 import Data.Text.Lazy (fromStrict)
 import GHC.Generics
 
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.ByteString.Lazy as B (toStrict)
 import qualified Data.HashMap.Strict as HM
 


@@ 23,14 23,19 @@ import Network.URI.Charset (convertCharset)
 import qualified Text.HTML.DOM as HTML
 import qualified Text.XML as XML
 import qualified Text.XML.Cursor as XC
+import qualified Text.XML.Cursor ((>=>))
 import qualified Data.Map as M
 
+import Internal.Forms
+
 mime = words "text/html text/xml application/xml application/xhtml+xml text/plain"
 
 load' :: Internal.Session -> URI -> IO ()
 load' session uri = modifyMVar_ session $ \session' -> maybeTimeout session' uri $ do
     resp@(redirected, _, _) <- fetchURL' (loader session') mime uri
-    return $ session' { currentURL = redirected, document = parseDocument resp, knownEls = HM.empty }
+    let doc = parseDocument resp
+    return $ session' { currentURL = redirected, document = doc,
+        knownEls = HM.empty, id2els = HM.fromList $ indexedIDs doc }
 
 maybeTimeout :: Session' -> URI -> IO Session' -> IO Session'
 maybeTimeout session uri act | currentURL session /= uri, Just delay <- pageLoad $ timeouts session =


@@ 179,3 184,9 @@ isClickableEl' (XML.Element _ attrs _)
     | Just src <- "src" `M.lookup` attrs', Just _ <- URI.parseURIReference $ Txt.unpack src = True
     | otherwise = False
   where attrs' = M.mapKeys XML.nameLocalName attrs
+
+indexedIDs doc = mapMaybe extractId $ XC.orSelf XC.descendant $ XC.fromDocument doc
+  where
+    extractId cursor | XML.NodeElement el@(XML.Element _ attrs _) <- XC.node cursor,
+        Just id <- "id" `M.lookup` M.mapKeys XML.nameLocalName attrs = Just (id, cursor)
+      | otherwise = Nothing