From 2106d710836920e7e2ee97de7e30ff0678b080ef Mon Sep 17 00:00:00 2001
From: Bogdan Popa <bogdan@defn.io>
Date: Fri, 1 Mar 2024 15:40:06 +0200
Subject: [PATCH] core,formular: add make-checkboxes and required/list

---
 congame-core/components/formular.rkt     | 46 ++++++++++++++++++++++++
 congame-example-study/conscript-form.rkt | 16 +++++++--
 2 files changed, 60 insertions(+), 2 deletions(-)

diff --git a/congame-core/components/formular.rkt b/congame-core/components/formular.rkt
index baed197..4bef2d7 100644
--- a/congame-core/components/formular.rkt
+++ b/congame-core/components/formular.rkt
@@ -37,6 +37,7 @@
  input-text
  input-time
  textarea
+ make-checkboxes
  make-radios)
 
 (define (kwd->symbol kwd)
@@ -528,6 +529,50 @@
              ,@((widget-errors) name value errors)))
            elt))]))
 
+(define ((required/list [message "You must select one or more items."]) xs)
+  (if (and xs
+           (pair? xs)
+           (not (null? xs)))
+      (ok xs)
+      (err message)))
+
+(define ((make-checkboxes options
+                          render-proc
+                          #:required? [required? #t]
+                          #:validators [validators null]
+                          #:attributes [attributes null]) meth)
+  (match meth
+    ['validator
+     (apply ensure
+            binding/list
+            (cond
+              [(string? required) (cons (required/list required) validators)]
+              [required? (cons (required/list) validators)]
+              [else validators]))]
+
+    ['widget
+     (lambda (name value errors)
+       (define (make-checkbox option [label ""])
+         (define the-values
+           (and value
+                (for/list ([bind (in-list (if (pair? value) value (list value)))])
+                  (string->symbol (bytes->string/utf-8 (binding:form-value bind))))))
+         (define attributes*
+           (if (and the-values (memq option the-values))
+               (cons '(checked "") attributes)
+               attributes))
+         `(label
+           (input
+            ([name ,name]
+             [type "checkbox"]
+             [value ,(symbol->string option)]
+             ,@attributes*))
+           ,label))
+       (haml
+        (.group
+         (render-proc options make-checkbox)
+         ,@((widget-errors) name value errors))))]))
+
 (define ((make-radios options
                       render-proc
                       #:required? [required? #t]
@@ -557,6 +602,7 @@
          (render-proc options make-radio)
          ,@((widget-errors) name value errors))))]))
 
+
 ;; help ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (cons/required? required? l)
diff --git a/congame-example-study/conscript-form.rkt b/congame-example-study/conscript-form.rkt
index 4f3b6d8..9b3999e 100644
--- a/congame-example-study/conscript-form.rkt
+++ b/congame-example-study/conscript-form.rkt
@@ -9,13 +9,25 @@
         @button{Continue}})
 
 (defstep (the-form)
-  (define (on-submit #:name n #:text t)
-    (eprintf "name: ~s text: ~s~n" n t))
+  (define (on-submit #:name n #:text t #:checkboxes cs)
+    (eprintf "name: ~s text: ~s checkboxes: ~s~n" n t cs))
+
+  (define options
+    '((a . "Option a")
+      (b . "Option b")))
+  (define (render-checkboxes options render-checkbox)
+    `(div
+      ()
+      ,@(for/list ([o (in-list options)])
+          (define v (car o))
+          (define l (cdr o))
+          (render-checkbox v l))))
 
   @html{@h1{The Form}
         @form[#:action on-submit]{
           @label{Name: @input-text[#:name] @~error[#:name]}
           @textarea[#:text]{Content:}
+          @binding[#:checkboxes @make-checkboxes[options render-checkboxes]]
           @submit-button}})
 
 (defstep (end)