From 989db10633271470147fddcdf7c1c0d2a35babe8 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 7 Dec 2023 17:08:54 +1300
Subject: [PATCH] Integrate normalization tighter into normalization.

---
 bureaucromancy.cabal           |  4 ++--
 src/Text/HTML/Form/Validate.hs | 16 ++++++++++++++--
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/bureaucromancy.cabal b/bureaucromancy.cabal
index c54817e..a5aae98 100644
--- a/bureaucromancy.cabal
+++ b/bureaucromancy.cabal
@@ -65,7 +65,7 @@ library
     exposed-modules:  Text.HTML.Form, Text.HTML.Form.Query,
         Text.HTML.Form.WebApp, Text.HTML.Form.WebApp.Ginger,
         Text.HTML.Form.WebApp.Ginger.Hourglass, Text.HTML.Form.WebApp.Ginger.TZ,
-        Text.HTML.Form.Colours
+        Text.HTML.Form.Colours, Text.HTML.Form.Validate
 
     -- Modules included in this library but not exported.
     -- other-modules:
@@ -76,7 +76,7 @@ library
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.16.4.0, ginger, file-embed-lzma, file-embed, mtl,
             bytestring, text, xml-conduit, network-uri, regex-tdfa, containers,
-            filepath, directory, hourglass >= 0.2.12 && < 0.3, tz >= 0.1 && < 0.2
+            filepath, directory, hourglass >= 0.2.12 && < 0.3, tz >= 0.1 && < 0.2,
 
     -- Directories containing source files.
     hs-source-dirs:   src
diff --git a/src/Text/HTML/Form/Validate.hs b/src/Text/HTML/Form/Validate.hs
index 09b028c..448fd48 100644
--- a/src/Text/HTML/Form/Validate.hs
+++ b/src/Text/HTML/Form/Validate.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Text.HTML.Form.Validate(
-        isInputValid, isFormValid, inputErrorMessage, normalizeInput) where
+module Text.HTML.Form.Validate(isInputValid, isInputValid', isFormValid, isFormValid',
+        inputErrorMessage, inputErrorMessage', normalizeInput, normalizeForm) where
 
 import Text.HTML.Form
 import qualified Data.Text as Txt
@@ -13,9 +13,15 @@ import Text.Regex.TDFA ((=~), matchTest)
 isFormValid :: Form -> Bool
 isFormValid = all isInputValid . inputs
 
+isFormValid' :: Form -> Bool
+isFormValid' = all isInputValid' . inputs
+
 isInputValid :: Input -> Bool
 isInputValid = null . inputErrorMessage
 
+isInputValid' :: Input -> Bool
+isInputValid' = null . inputErrorMessage'
+
 inputErrorMessage :: Input -> [Char]
 inputErrorMessage Input { inputType = "hidden" } = "" -- Don't validate hiddens!
 inputErrorMessage self@Input { required = True }
@@ -82,6 +88,9 @@ inputErrorMessage self@Input { inputType = "url" }
 inputErrorMessage self@Input { inputType = "week" } = isTime' self
 inputErrorMessage _ = ""
 
+inputErrorMessage' :: Input -> [Char]
+inputErrorMessage' = inputErrorMessage . normalizeInput
+
 parseTime :: String -> Maybe DateTime
 parseTime = fmap localTimeUnwrap . localTimeParse ISO8601_DateAndTime
 isTime :: Input -> Bool
@@ -101,3 +110,6 @@ normalizeInput self@Input { inputType = "url", value = val }
         }
 -- Other aspects we wish to normalize?
 normalizeInput self = self
+
+normalizeForm :: Form -> Form
+normalizeForm self = self { inputs = map normalizeInput $ inputs self }
-- 
2.30.2