5 files changed, 46 insertions(+), 14 deletions(-)

M app/Main.hs
M src/Text/HTML/Form.hs
M src/Text/HTML/Form/Query.hs
M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger.hs

@@ 7,13 7,15 @@ import Network.HTTP.Types
 import System.Environment (getArgs)
 
 import Text.HTML.Form.WebApp
+import Text.HTML.Form.Query
 import Text.HTML.Form
 
 import Data.Text.Lazy.Encoding (encodeUtf8)
+import qualified Data.Text.Encoding as Txt
 import Data.Text.Lazy (fromStrict)
 import qualified Data.Text as Txt
 import qualified Text.HTML.DOM as HTML
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 
 main :: IO ()
 main = do


@@ 29,5 31,11 @@ servePage :: Form -> Application
 servePage form req respond = do
     ret <- renderPage form (pathInfo req) (queryString req)
     case ret of
-        Just txt -> respond $ responseLBS status200 [] $ encodeUtf8 $ fromStrict txt
+        Just (Right txt) ->
+            respond $ responseLBS status200 [] $ encodeUtf8 $ fromStrict txt
+        Just (Left qs) -> respond $ responseLBS status200 [] $
+            encodeUtf8 $ fromStrict $ Txt.pack $ renderQueryString'
+            [(utf8 k, utf8 $ fromMaybe "" v) | (k, v) <- qs]
         Nothing -> respond $ responseLBS status404 [] "Unknown input or operation!"
+
+utf8 = Txt.unpack . Txt.decodeUtf8

@@ 143,7 143,10 @@ queryInputs form = (allInputs >=> inForm) form
     nestedInForm x = listToMaybe ((ancestor >=> laxElement "form") x) == Just form
 parseInput :: Cursor -> Maybe Input
 parseInput el | _:_ <- laxElement "input" el = Just Input {
-        label = fromMaybe (attr "name" el "") $ fmap text label',
+        label = fromMaybe
+                -- Additional fallbacks are primarily for buttons
+                (attr "name" el $ attr "value" el $ attr "alt" el $
+                attr "type" el "text") $ fmap text label',
         description = fromMaybe (mkEl $ attr "title" el "") $ fmap node $
             elByID (attr "aria-describedby" el "") `orElse` label',
         inputType = attr "type" el "text",


@@ 151,8 154,10 @@ parseInput el | _:_ <- laxElement "input" el = Just Input {
         inputAutocomplete = attr "autocomplete" el "on",
         autofocus = hasAttr "autofocus" el,
         checked = hasAttr "checked" el,
-        disabled = hasAttr "disabled" el,
-        readonly = hasAttr "readonly" el,
+        -- NOTE: No remaining harm in displaying hidden inputs,
+        -- might be informative...
+        disabled = hasAttr "disabled" el || attr "type" el "" == "hidden",
+        readonly = hasAttr "readonly" el || attr "type" el "" == "hidden",
         multiple = hasAttr "multiple" el,
         dirname = attr "dirname" el "",
         inputName = attr "name" el "",

@@ 17,6 17,8 @@ renderQueryString' query = intercalate "&" [
 renderQuery' :: Form -> [(String, String)]
 renderQuery' form = concatMap renderInput' $ inputs form
 renderInput' :: Input -> [(String, String)]
+renderInput' Input { inputType = inputType' }
+    | inputType' `elem` ["submit", "reset", "button"] = []
 renderInput' Input { checked = False, inputType = inputType' }
     | inputType' `elem` ["radio", "checkbox"] = []
 renderInput' Input { inputType = "<select>",

@@ 12,18 12,19 @@ import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist)
 
 import Text.HTML.Form (Form(..), Input(..))
 import Text.HTML.Form.WebApp.Ginger (template, resolveSource)
-import Text.HTML.Form.Query (renderQueryString)
+import Text.HTML.Form.Query (renderQueryString, renderQuery')
 
-renderPage :: Form -> [Text] -> [(ByteString, Maybe ByteString)] -> IO (Maybe Text)
+type Query = [(ByteString, Maybe ByteString)]
+renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text))
 renderPage form (n:path) query
     | Just ix <- readMaybe $ Txt.unpack n, ix < Prelude.length (inputs form) =
         renderInput form ix (inputs form !! ix) path query
-renderPage form [] _ = return $ Just $ Txt.concat [
+renderPage form [] _ = return $ Just $ Right $ Txt.concat [
     "<a href='/0/?", Txt.pack $ renderQueryString form, "'>Start!</a>"]
 renderPage _ _ _ = return Nothing
 
 renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->
-    IO (Maybe Text)
+    IO (Maybe (Either Query Text))
 renderInput form ix input [""] qs = renderInput form ix input [] qs
 renderInput form ix input@Input { multiple = True } [p] qs
     | '=':v' <- Txt.unpack p,


@@ 64,6 65,19 @@ renderInput form ix input@Input {inputType="radio", inputName=k', value=v'} [] q
     template "checkbox.html" form ix input $ set k' v' qs
 renderInput form ix input@Input { inputType="<select>" } [] qs =
     template "select.html" form ix input qs
+renderInput form ix input@Input { inputType="submit" } [] qs =
+    template "submit.html" form ix input qs
+renderInput _ _ input@Input { inputType="submit" } ["_"] qs =
+    return $ Just $ Left $ set (inputName input) (value input) qs
+renderInput form ix input@Input { inputType="image" } [] qs =
+    template "image-button.html" form ix input qs
+renderInput _ _ input@Input { inputType="image" } ["_"] qs =
+    return $ Just $ Left $ set (inputName input) (value input) qs
+renderInput form ix input@Input { inputType="reset" } [] qs =
+    template "reset.html" form ix input qs
+renderInput form ix input@Input { inputType="reset" } ["_"] _ =
+    template "reset.html" form ix input
+        [(utf8' k, Just $ utf8' v) | (k, v) <- renderQuery' form]
 renderInput form ix input [keyboard] qs =
     renderInput form ix input [keyboard, ""] qs
 renderInput form ix input [keyboard, ""] qs | Just (Just _) <- resolveSource path =


@@ 92,7 106,7 @@ renderInput form ix input [] qs = do
             | otherwise = "latin1"
     template ("keyboards/" ++ keyboard' ++ ".html") form ix input qs
 renderInput _ _ input _ _ =
-    return $ Just $ Txt.concat ["Unknown input type: ", inputType input]
+    return $ Just $ Right $ Txt.concat ["Unknown input type: ", inputType input]
 
 utf8 :: Text -> ByteString
 utf8 = Txt.encodeUtf8


@@ 100,6 114,7 @@ utf8' :: String -> ByteString
 utf8' = utf8 . Txt.pack
 set :: Text -> Text -> [(ByteString, Maybe ByteString)]
     -> [(ByteString, Maybe ByteString)]
+set "" _ qs = qs -- Mostly for buttons!
 set k' v' qs = (utf8 k', Just $ utf8 v'):[q | q@(k, _) <- qs, k /= utf8 k']
 unset :: Text -> Text -> [(ByteString, Maybe ByteString)]
     -> [(ByteString, Maybe ByteString)]

@@ 27,13 27,15 @@ import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Map as M
 
 type Query = [(ByteString, Maybe ByteString)]
-template :: Monad m => String -> Form -> Int -> Input -> Query -> m (Maybe Text)
+template :: Monad m => String -> Form -> Int -> Input -> Query ->
+        m (Maybe (Either Query Text))
 template name form ix input query
     | Just (Right tpl) <- parseGingerFile resolveSource name =
-        return $ Just $ htmlSource $ flip runGinger tpl $ makeContextHtml ctxt
+        return $ Just $ Right $ htmlSource $
+            flip runGinger tpl $ makeContextHtml ctxt
     | Just (Left err) <- parseGingerFile resolveSource name =
-        return $ Just $ Txt.pack $ show err
-    | otherwise = return $ Just "Unexpected error!"
+        return $ Just $ Right $ Txt.pack $ show err
+    | otherwise = return $ Just $ Right "Unexpected error!"
   where
     ctxt :: Text -> GVal (Run SourcePos (Writer Html) Html)
     ctxt "Q" = query2gval query