~alcinnz/bureaucromancy: Integrate & fix error messages; TODO: Block invalid submits

6 files changed, 21 insertions(+), 6 deletions(-)

M form.html
M src/Text/HTML/Form/Query.hs
M src/Text/HTML/Form/Validate.hs
M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger.hs
M tpl/base.html

M form.html => form.html +2 -2

@@ 6,7 6,7 @@
 </head>
 <body>
   <form>
-    <label><input type="checkbox" name="tos" checked value="yes" title="You must agree to the terms & conditions!" />I agree to the terms &amp; conditions</label>
+    <label><input type="checkbox" name="tos" checked value="yes" title="You must agree to the terms & conditions!" required />I agree to the terms &amp; conditions</label>
     <label><input type="radio" name="char" value="kaley" />Kaley Fawn</label>
     <label><input type="radio" name="char" value="horatio" />Prof Graw Horatio</label>
     <label><input type="radio" name="char" value="udo" />Udo Malaaki</label>


@@ 18,7 18,7 @@
     <label><input type="number" name="numerator" />Numerator</label>
     <label><input type="range" min="1" max="42" name="denominator" />Denominator</label>
     <label><input type="week" name="published" />Published at</label>
-    <label><input type="color" name="colour" />What is your favourite colour?</label>
+    <label><input type="color" name="colour" required />What is your favourite colour?</label>
   </form>
 </body>
 </html>

M src/Text/HTML/Form/Query.hs => src/Text/HTML/Form/Query.hs +8 -1

@@ 1,11 1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Text.HTML.Form.Query(
-    renderQueryString, renderQueryString', renderQuery') where
+    renderQueryString, renderQueryString', renderQuery', applyQuery) where
 
 import Text.HTML.Form (Form(..), Input(..), OptionGroup(..), Option(..))
 import Network.URI (escapeURIString, isUnescapedInURIComponent)
 import Data.List (intercalate)
 import Data.Text (unpack)
+import qualified Data.Text as Txt
 
 renderQueryString :: Form -> String
 renderQueryString = renderQueryString' . renderQuery'


@@ 34,3 35,9 @@ renderInput' Input { inputName = k, value = v } = [(unpack k, unpack v)]
 
 escape :: String -> String
 escape = escapeURIString isUnescapedInURIComponent
+
+applyQuery :: Input -> [(String, String)] -> Input
+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

M src/Text/HTML/Form/Validate.hs => src/Text/HTML/Form/Validate.hs +2 -2

@@ 69,7 69,7 @@ inputErrorMessage Input {
 
 -- Validation specific to input types
 inputErrorMessage self@Input { inputType = "color" }
-    | value self =~ ("#[0-9a-fA-F]{6}" :: String) = "Invalid colour value!"
+    | ("#[0-9a-fA-F]{6}" :: String) =~ value self = "Invalid colour value!"
 inputErrorMessage self@Input { inputType = "date" } = isTime' self
 inputErrorMessage self@Input { inputType = "datetime" } = isTime' self
 inputErrorMessage self@Input { inputType = "datetime-local" } = isTime' self


@@ 105,7 105,7 @@ isURL = isNothing . parseAbsoluteURI . Txt.unpack
 
 normalizeInput :: Input -> Input
 normalizeInput self@Input { inputType = "url", value = val }
-    | not $ isURL val, isURL ("https://" `Txt.append` val) = self {
+    | not $ ':' `Txt.elem` val = self { -- Is there a better check?
             value = "https://" `Txt.append` val
         }
 -- Other aspects we wish to normalize?

M src/Text/HTML/Form/WebApp.hs => src/Text/HTML/Form/WebApp.hs +1 -1

@@ 172,7 172,7 @@ renderInput form ix input@Input { inputType = "color" } [] qs =
         "shades" -> toGVal False
         "subfolder" -> toGVal False
         _ -> toGVal ()
-renderInput form ix input@Input { inputType = "color", inputName = n } [c, ""] qs =
+renderInput form ix input@Input { inputType = "color" } [c, ""] qs =
     template' "color.html" form ix input qs $ \x -> case x of
         "colours" -> V.list $ L.map colourGVal tailwindColours
         "shades" -> case Txt.unpack c `lookup` tailwindColours of

M src/Text/HTML/Form/WebApp/Ginger.hs => src/Text/HTML/Form/WebApp/Ginger.hs +5 -0

@@ 26,6 26,9 @@ import Data.List (nub)
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Map as M
 
+import Text.HTML.Form.Validate (inputErrorMessage')
+import Text.HTML.Form.Query (applyQuery)
+
 type Query = [(ByteString, Maybe ByteString)]
 template :: Monad m => String -> Form -> Int -> Input -> Query ->
         m (Maybe (Either Query Text))


@@ 90,6 93,8 @@ input2gval :: (Int, Input) -> Query -> GVal m
 input2gval (ix, input) query = orderedDict [
     "index"       ~> ix,
     "label"       ~> label input,
+    "error"       ~> inputErrorMessage' (applyQuery input
+            [(B8.unpack k, B8.unpack $ fromMaybe "" v) | (k, v) <- query]),
     "description" ~> html (description input),
     "inputType"   ~> inputType input,
     "dirName"     ~> dirname input,

M tpl/base.html => tpl/base.html +3 -0

@@ 26,6 26,8 @@
 
     table td:not([colspan]) { width: 25% }
     table td { text-align: center }
+
+    .error { color: red; }
   </style>
 </head>
 <body>


@@ 39,6 41,7 @@
       {% if input.disabled %}{{ input.label }}
       {% else %}<a href="/{{input.index}}/{{Q}}" title="{{input.title}}">{{ input.label }}</a>
       {% endif %}</dt>
+    {% if input.error %}<dd class="error">⚠️ {{ input.error }}</dd>{% endif %}
     {% if input.type != 'password' %}
       <dd class="{% if input.readonly %}readonly{% endif %}"
           {% if input.inputType == "color" %}style="background-color: {{ input.value }}"{% endif %}>