5 files changed, 60 insertions(+), 6 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 tpl/submit.html

@@ 25,7 25,8 @@ main = do
         [n] -> (n, "0")
         [] -> ("form.html", "0")
   doc <- HTML.readFile filename
-  runEnv 2018 $ servePage $ fromJust $ parseDocument doc $ Txt.pack ident
+  let form = ensureButtons $ fromJust $ parseDocument doc $ Txt.pack ident
+  runEnv 2018 $ servePage form
 
 servePage :: Form -> Application
 servePage form req respond = do

@@ 1,7 1,7 @@
 {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
 module Text.HTML.Form (Form(..), Input(..), OptionGroup(..), Option(..),
     FileSelector(..), defaultFileData, ImageData(..), defaultImageData,
-    TextArea(..), defaultTextArea, parseElement, parseDocument) where
+    TextArea(..), defaultTextArea, parseElement, parseDocument, ensureButtons) where
 
 import Data.Text (Text)
 import qualified Data.Text as Txt


@@ 373,3 373,42 @@ text :: Cursor -> Text
 text = Txt.concat . (descendant >=> content)
 mkEl :: Text -> Node
 mkEl = NodeContent
+
+ensureButtons :: Form -> Form
+ensureButtons = ensureButton "submit" "Submit" . ensureButton "reset" "Reset"
+  where
+    ensureButton typ label' form
+        | any (\x -> inputType x == typ) $ inputs form = form
+        | otherwise = form { inputs = inputs form ++ [button typ label'] }
+    button typ label' = Input {
+        label = label',
+        description = mkEl "",
+        autofocus = False,
+        disabled = False,
+        formAction = Nothing,
+        formMethod = Nothing,
+        formEnctype = Nothing,
+        formValidate = True,
+        formTarget = Nothing,
+        inputName = "",
+        inputType = typ,
+        value = "",
+        title = "",
+        placeholder = "",
+        dirname = "",
+        inputAutocomplete = "",
+        checked = False, -- Switch to true for the activated button!
+        readonly = False,
+        multiple = False,
+        inputMode = "",
+        list = [],
+        range = (Nothing, Nothing),
+        step = Nothing,
+        lengthRange = (Nothing, Nothing),
+        pattern = Nothing,
+        required = False,
+        size = Nothing,
+        fileData = defaultFileData,
+        imageData = defaultImageData,
+        textArea = defaultTextArea
+      }

@@ 1,6 1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Text.HTML.Form.Query(
-    renderQueryString, renderQueryString', renderQuery', applyQuery) where
+module Text.HTML.Form.Query(renderQueryString, renderQueryString', renderQuery',
+        applyQuery, applyQuery') where
 
 import Text.HTML.Form (Form(..), Input(..), OptionGroup(..), Option(..))
 import Network.URI (escapeURIString, isUnescapedInURIComponent)


@@ 41,3 41,5 @@ applyQuery input@Input { inputName = n } qs
     | inputType input `notElem` ["submit", "reset", "button", "checkbox", "radio"],
         Just val' <- unpack n `lookup` qs = input { value = Txt.pack val' }
     | otherwise = input
+applyQuery' :: Form -> [(String, String)] -> Form
+applyQuery' form qs = form { inputs = flip applyQuery qs `map` inputs form }

@@ 2,9 2,11 @@
 module Text.HTML.Form.WebApp (renderPage, Form(..)) where
 
 import Data.ByteString as BS
+import Data.ByteString.Char8 as B8
 import Data.Text as Txt
 import Data.Text.Encoding as Txt
 import Data.List as L
+import Data.Maybe (fromMaybe)
 import Text.Read (readMaybe)
 import Network.URI (unEscapeString)
 import System.IO (readFile')


@@ 14,7 16,8 @@ import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist,
 
 import Text.HTML.Form (Form(..), Input(..))
 import Text.HTML.Form.WebApp.Ginger (template, template', resolveSource, list')
-import Text.HTML.Form.Query (renderQueryString, renderQuery')
+import Text.HTML.Form.Query (renderQueryString, renderQuery', applyQuery')
+import Text.HTML.Form.Validate (isFormValid')
 import Text.HTML.Form.WebApp.Ginger.Hourglass (timeData, modifyTime', timeParseOrNow,
         gSeqTo, gPad2)
 import Text.HTML.Form.WebApp.Ginger.TZ (tzdata, continents)


@@ 107,7 110,10 @@ renderInput form ix input@Input {inputType="radio", inputName=k', value=v'} [] q
 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
+    template' "submit.html" form ix input qs $ \x -> case x of
+        "isFormValid" -> toGVal $ formValidate input &&
+                isFormValid' (applyQuery' form $ strQuery qs)
+        _ -> toGVal ()
 renderInput _ _ input@Input { inputType="submit" } ["_"] qs =
     return $ Just $ Left $ set (inputName input) (value input) qs
 renderInput form ix input@Input { inputType="image" } [] qs =


@@ 231,6 237,8 @@ get k' qs
     | Just (Just ret) <- utf8 k' `lookup` qs =
         Txt.unpack $ Txt.decodeUtf8 ret
     | otherwise = ""
+strQuery :: [(ByteString, Maybe ByteString)] -> [(String, String)]
+strQuery qs = [(B8.unpack k, B8.unpack $ fromMaybe "" v) | (k, v) <- qs]
 
 partitionM :: Monad f => (a -> f Bool) -> [a] -> f ([a], [a])
 partitionM _ [] = pure ([], [])

@@ 3,8 3,12 @@
 {%- block main -%}<section>
   <div>{{ input.description }}</div>
   <hr />
+  {% if isFormValid %}
   <!-- TODO: Internationalize! -->
   <p><a href="_{{Q}}">Upload</a> to
     <code>{{ input.form.action|default(form.action) }}
         ({{ input.form.method|default(form.method) }})</code></p>
+  {% else %}
+  <p>Please correct errors listed in sidebar before submitting this form!</p>
+  {% endif %}
 </section>{%- endblock -%}