From 50d1a28d6c3ed29698e5761ccb79df9a9c5b1ba2 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 25 Oct 2023 13:04:08 +1300 Subject: [PATCH] Implement typing, deletion. --- form.html | 16 ++++++ src/Text/HTML/Form/WebApp.hs | 22 +++++++++ starbuzz.html | 32 ++++++++++++ tpl/base.html | 2 +- tpl/latin1-accent-lower.html | 55 +++++++++++++++++++++ tpl/latin1-accent.html | 56 +++++++++++++++++++++ tpl/latin1-symbol.html | 96 ++++++++++++++++++++++++++++++++++++ tpl/latin1-upper.html | 63 +++++++++++++++++++++++ tpl/latin1.html | 63 +++++++++++++++++++++++ tpl/select.html | 32 ++++++++++++ 10 files changed, 436 insertions(+), 1 deletion(-) create mode 100644 form.html create mode 100644 starbuzz.html create mode 100644 tpl/latin1-accent-lower.html create mode 100644 tpl/latin1-accent.html create mode 100644 tpl/latin1-symbol.html create mode 100644 tpl/latin1-upper.html create mode 100644 tpl/latin1.html create mode 100644 tpl/select.html diff --git a/form.html b/form.html new file mode 100644 index 0000000..d992a0b --- /dev/null +++ b/form.html @@ -0,0 +1,16 @@ + + + + + Test form + + +
+ + + + + +
+ + diff --git a/src/Text/HTML/Form/WebApp.hs b/src/Text/HTML/Form/WebApp.hs index a984614..e5d28ed 100644 --- a/src/Text/HTML/Form/WebApp.hs +++ b/src/Text/HTML/Form/WebApp.hs @@ -35,6 +35,23 @@ renderInput form ix input@Input { multiple = True } [p] qs renderInput form ix input [p] qs | '=':v' <- Txt.unpack p = renderInput form ix input [] $ set (inputName input) (Txt.pack $ unEscapeString v') qs + | ':':v' <- Txt.unpack p = renderInput form ix input [] $ + set (inputName input) + (Txt.pack (get (inputName input) qs ++ v')) qs + | "-" <- Txt.unpack p, v'@(_:_) <- get (inputName input) qs = + renderInput form ix input [] $ set (inputName input) + (Txt.pack $ Prelude.init v') qs + | "-" <- Txt.unpack p = renderInput form ix input [] qs +renderInput form ix input [x, p] qs + | '=':v' <- Txt.unpack p = renderInput form ix input [x] $ + set (inputName input) (Txt.pack $ unEscapeString v') qs + | ':':v' <- Txt.unpack p = renderInput form ix input [x] $ + set (inputName input) + (Txt.pack (get (inputName input) qs ++ v')) qs + | "-" <- Txt.unpack p, v'@(_:_) <- get (inputName input) qs = + renderInput form ix input [x] $ set (inputName input) + (Txt.pack $ Prelude.init v') qs + | "-" <- Txt.unpack p = renderInput form ix input [x] qs renderInput form ix input@Input {inputType="checkbox", inputName=k', value=v'} [] qs | (utf8 k', Just $ utf8 v') `Prelude.elem` qs = template "checkbox.html" form ix input $ unset k' v' qs @@ -72,3 +89,8 @@ 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)] unset k' v' qs = [q | q@(k, v) <- qs, not (k == utf8 k' && v == Just (utf8 v'))] +get :: Text -> [(ByteString, Maybe ByteString)] -> String +get k' qs + | Just (Just ret) <- utf8 k' `lookup` qs = + Txt.unpack $ Txt.decodeUtf8 ret + | otherwise = "" diff --git a/starbuzz.html b/starbuzz.html new file mode 100644 index 0000000..81a3b69 --- /dev/null +++ b/starbuzz.html @@ -0,0 +1,32 @@ +
+

+
+ +

+

Extras:
+ +
+ +

+

Ship to:
+
+
+
+
+
+

+

Customer Comments:
+ +

+

+ +

+
diff --git a/tpl/base.html b/tpl/base.html index c859e9f..17db7aa 100644 --- a/tpl/base.html +++ b/tpl/base.html @@ -46,7 +46,7 @@ {% for opt in grp.opts %} {% if opt.disabled %}
{{ opt.label }}
{% else %}
- + {{ opt.label }}
{% endif %} {% endfor %} diff --git a/tpl/latin1-accent-lower.html b/tpl/latin1-accent-lower.html new file mode 100644 index 0000000..9d98214 --- /dev/null +++ b/tpl/latin1-accent-lower.html @@ -0,0 +1,55 @@ +{% extends "base.html" %} + +{%- block control -%}
+

abc | ABC | + !@# | àêï | + ÀÊÏ

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
àáâäãå
èéêëçæ
ìíîïðñ
òóôöõø
ùúûüýÿ
þSPACEDELCLEAR
+
{%- endblock -%} diff --git a/tpl/latin1-accent.html b/tpl/latin1-accent.html new file mode 100644 index 0000000..65e2ed7 --- /dev/null +++ b/tpl/latin1-accent.html @@ -0,0 +1,56 @@ +{% extends "base.html" %} + +{%- block control -%}
+

abc | ABC | + !@# | + àêï | + ÀÊÏ

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ÀÁÂÄÃÅ
ÈÉÊËÇÆ
ÌÍÎÏÐÑ
ÒÓÔÖÕØ
ÙÚÛÜÝß
ÞSPACEDELCLEAR
+
{%- endblock -%} diff --git a/tpl/latin1-symbol.html b/tpl/latin1-symbol.html new file mode 100644 index 0000000..ec0da51 --- /dev/null +++ b/tpl/latin1-symbol.html @@ -0,0 +1,96 @@ +{% extends "base.html" %} + +{%- block control -%}
+

abc | ABC | + !@# | àêï | + ÀÊÏ

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
?,.:;()
/="'![]
\~`|@{}
¸%^&*<>
#$-_´·
×¢£¤¥«»
÷§¨©ª¡¦
µ¬¯®°±¿
º¹²³¼½¾
+SPACEDELCLEAR
+
{%- endblock -%} diff --git a/tpl/latin1-upper.html b/tpl/latin1-upper.html new file mode 100644 index 0000000..7c7da7d --- /dev/null +++ b/tpl/latin1-upper.html @@ -0,0 +1,63 @@ +{% extends "base.html" %} + +{%- block control -%}
+

abc | ABC | + !@# | + àêï | + ÀÊÏ

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ABCDEF
GHIJKL
MNOPQR
STUVWX
YZ1234
567890
SPACEDELCLEAR
+
{%- endblock -%} diff --git a/tpl/latin1.html b/tpl/latin1.html new file mode 100644 index 0000000..be0061b --- /dev/null +++ b/tpl/latin1.html @@ -0,0 +1,63 @@ +{% extends "base.html" %} + +{%- block control -%}
+

abc | ABC | + !@# | + àêï | + ÀÊÏ

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
abcdef
ghijkl
mnopqr
stuvwx
yz1234
567890
SPACEDELCLEAR
+
{%- endblock -%} diff --git a/tpl/select.html b/tpl/select.html new file mode 100644 index 0000000..eb9c785 --- /dev/null +++ b/tpl/select.html @@ -0,0 +1,32 @@ +{% extends "base.html" %} + +{%- block main -%}
+

{{ input.label }}

+ {{ input.description }} +
+ +
{%- endblock -%} -- 2.30.2