2 files changed, 40 insertions(+), 2 deletions(-)

M src/Internal/Forms.hs
M src/Internal/Load.hs

@@ 1,5 1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Internal.Forms(findForm, prefillForm, modifyForm) where
+module Internal.Forms(findForm, prefillForm, modifyForm, formAction) where
 
 import Text.XML
 import Text.XML.Cursor


@@ 8,6 8,7 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.Text as Txt
 
 import Internal (Session, Session'(..))
+import Network.URI (URI(..), parseURIReference, relativeTo, nullURI)
 
 import Data.Maybe
 import Control.Concurrent.MVar


@@ 66,3 67,35 @@ modifyForm cb name el session = modifyMVar_ session $ \session' -> do
         Element (Name "form" _ _) _ _ ->
             session' { forms = M.insert form new $ forms session' }
         _ -> session'
+
+serializeForm :: HM.HashMap Txt.Text [Txt.Text] -> Txt.Text
+serializeForm = Txt.intercalate "&" . map joinEntry . expandValues . HM.toList
+    where
+        expandValues ((a, (b:bs)):rest) = (a, b):expandValues ((a, bs):rest)
+        expandValues ((a, []):rest) = expandValues rest
+        expandValues [] = []
+        joinEntry (key, value) = key `Txt.append` Txt.cons '=' value
+
+formAction :: Cursor -> Session -> IO (URI, Txt.Text, Txt.Text)
+formAction el session = withMVar session $ \session' -> do
+    let form = findForm el $ id2els session'
+    let blanked = prefillForm form $ fromDocument $ document session'
+    let inputs = M.findWithDefault blanked form $ forms session'
+    let query = serializeForm inputs
+
+    let fAttrs' = M.mapKeys nameLocalName $ elementAttributes form
+    let iAttrs' = case node el of {
+        NodeElement (Element _ attrs _) -> M.mapKeys nameLocalName attrs;
+        _ -> M.empty
+    }
+    let action = case ("formaction" `M.lookup` iAttrs', "action" `M.lookup` fAttrs') of {
+        (Just action, _) -> parseURIReference $ Txt.unpack action;
+        (_, Just action) -> parseURIReference $ Txt.unpack action;
+        (_, _) -> Nothing
+    }
+    let method = case ("formmethod" `M.lookup` iAttrs', "action" `M.lookup` fAttrs') of {
+        (Just method, _) -> method;
+        (_, Just method) -> method;
+        (_, _) -> "GET"
+    }
+    return (fromMaybe nullURI action `relativeTo` currentURL session', query, method)

@@ 175,7 175,12 @@ clickEl' session (XML.Element (XML.Name name _ _) attrs _) cursor
         base <- withMVar session (return . Internal.currentURL)
         load session $ URI.relativeTo uri base
     -- FORMS
-    -- TODO type=submit
+    | name `elem` ["button", "input"], Just "submit" <- "type" `M.lookup` attrs' = do
+        case ("name" `M.lookup` attrs', "value" `M.lookup` attrs') of
+            (Just name, Just value) -> modifyForm ((:) value) name cursor session
+            _ -> return ()
+        (uri, query, method) <- formAction cursor session
+        load session uri { uriQuery = '?':Txt.unpack query }
     | name `elem` ["button", "input"], Just "reset" <- "type" `M.lookup` attrs' =
       modifyMVar_ session $ \session' -> do
         let form = findForm cursor $ id2els session'