autoassign/html-elements.scm

(define-module (html-elements)
  #:use-module (srfi srfi-9)
  #:export (my-input
            form-item))

(define-syntax my-define-record-type
  (syntax-rules ()
    ((my-define-record-type type
                            constructor
                            constructor?
                            (fieldname var1) ...)
     (define-record-type type
       (constructor fieldname  ...)
       constructor?
       (fieldname var1) ... ))))

(my-define-record-type <form-item>
                       make-form-item
                       form-item?
                       (label form-item-label)
                       (id form-item-id)
                       (input-type form-item-input-type)
                       (options form-item-options)
                       (placeholder form-item-placeholder)
                       (required form-item-required))

(define* (my-select id
                    #:key
                    (required #t)
                    (options #f))
  `(select (@ (id ,id)
              (name ,id)
              ,(if (eq? required #t)
                   '(required)
                   '(not-required))
              (class "custom-select"))
           (option (@ (value "")
                      (selected ""))
                   "Choose...")
           ,(let loop ([options options])
              (if (null? options)
                  '()
                  (cons `(option (@ (value ,(car options)))
                                 ,(car options))
                        (loop (cdr options)))))))

(define* (my-radio label
                   #:optional
                   #:key
                   id
                   name
                   options)
  `(li
    ,(let loop ([options options])
       (if (null? options)
           '()
           `((label ,(car options))
             (input (@ (id, ,(car options))
                       (name ,(car options))
                       (value ,(car options))
                       (type, "radio")))
             ,(loop (cdr options)))))))

(define* (my-input label
                   #:optional
                   #:key
                   id
                   (input-type "text")
                   (options #f)
                   (placeholder "")
                   (required #t)
                   value
                   )
  (let ([id (if (not id)
                label
                id)])
    (cond [(string= input-type "select")
           (my-select id #:options options #:required required)]
          [(string= input-type "textarea")
           `(textarea (@ (id ,id)
                         (name ,id)
                         (type ,input-type)
                         ,(if (eq? required #t)
                              '(required)
                              '(not-required))
                         ;; the "" is necessary to make sxml put a
                         ;; closing </textarea>
                         (placeholder ,placeholder)) "")]
          [else (let ([input "input"])
                  (when (string= input-type "textarea")
                    (set! input "textarea"))
                  `(input (@ (id ,id)
                             (name ,id)
                             (type ,input-type)
                             ,(if (eq? required #t)
                                  '(required))
                             ,(if (not (boolean? value))
                                  `(value ,value)
                                  '(value))
                             (placeholder ,placeholder))))])))


(define* (form-item label
                    #:key
                    (id label)
                    (input-type "text")
                    (placeholder "")
                    (required #t)
                    options
                    (width 8))
  (define form-item-a (make-form-item
                       label
                       id
                       input-type
                       options
                       placeholder
                       required))
  (if (string= input-type "radio")
      (my-radio label #:options options)
      `(li
        (label (@ (for ,(form-item-id form-item-a)))
               ,((lambda (label) ;;capitalize first letter
                   (let ([string-list (string->list label)])
                     (list->string (cons (char-upcase (car string-list))
                                         (cdr string-list)))))
                 (form-item-label form-item-a)))
        ,(my-input (form-item-label form-item-a)
                   #:id (form-item-id form-item-a)
                   #:input-type (form-item-input-type form-item-a)
                   #:options (form-item-options form-item-a)
                   #:placeholder (form-item-placeholder form-item-a)
                   #:required (form-item-required form-item-a)))))