marcuskammer/dev.metalisp.sbt
1
1
Fork 0
Code Issues 1 Pull requests Projects 1 Releases Packages Wiki Activity Actions

Add a form creation DSL

Browse source
This commit is contained in:
Marcus Kammer 2024-04-22 15:57:42 +02:00
parent f6a08eb8bd
commit 64989d3fe8
1 changed files with 216 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

217
src/form.lisp
View file

@ -27,6 +27,8 @@
:dev.metalisp.sbt/utility
:spacing)
(:export
:root
:form
:checkable
:checkable-radio
:checkable-checkbox
@ -65,7 +67,7 @@
;;; form
(defmacro form (&optional attr &body body)
(defmacro root (&optional attr &body body)
"Generates HTML form element.
LEGEND: Add text for <legend>. A short description for forms.
@ -282,3 +284,216 @@ Example usage:
(find-l10n "search"
spinneret:*html-lang*
*l10n*)))))
;;; TODO input groups
;;; form DSL
(deftype composite-list ()
"Represents a composite list that can either be a valid `choices` or `question`.
A composite list is expected to satisfy either the `choicesp` or `questionp` predicate."
'(or (satisfies choicesp)
(satisfies questionp)))
(defun choicep (lst)
"Checks if the given list LST is a valid choice.
A valid choice list starts with a keyword, followed by strings.
Returns T if it's a valid choice list, otherwise NIL."
(and (keywordp (first lst))
(every #'stringp (rest lst))))
(deftype choice ()
"Represents a valid choice list.
A choice list is expected to satisfy the `choicep` predicate."
'(and list (satisfies choicep)))
(defun choicesp (lst)
"Checks if the given list LST contains only keyword or string elements.
Returns T if all elements are either keywords or strings, otherwise NIL."
(loop for elem in lst
always (and (keywordp (first lst))
(or (keywordp elem)
(stringp elem)))))
(deftype choices ()
"Represents a valid choices list.
A choices list is expected to satisfy the `choicesp` predicate."
'(and list (satisfies choicesp)))
(defun questionp (lst)
"Checks if the given list LST is a valid question.
A valid question is a list of alternating keywords and either strings or lists
satisfying `choicesp`.
Returns T if it's a valid question, otherwise NIL."
(if (= (length lst) 6)
(loop for i from 0 below (length lst)
for elem = (nth i lst)
always (if (evenp i)
(keywordp elem)
(or (stringp elem)
(choicesp elem))))
nil))
(deftype question ()
"Represents a valid question list.
A question list is expected to satisfy the `questionp` predicate."
'(and list (satisfies questionp)))
(declaim (ftype (function (question) (values string string list)) extract-question-components))
(defun extract-question-components (question)
"Extracts components of a question stored as a plist.
QUESTION: A plist representing a question.
Returns multiple values:
- The question text (ASK)
- The group name (GROUP)
- The choices (CHOICES)"
(let ((splitted-list (split-list-by-keyword question)))
(apply #'values (mapcar (lambda (x) (nth 1 x)) splitted-list))))
(declaim (ftype (function (composite-list) list) split-list-by-keyword))
(defun split-list-by-keyword (lst)
"Splits a list (LST) into a list of smaller lists, each starting with a keyword.
LST: A list that includes keywords followed by their associated values. The
list can be a standard property list or a key-grouped list.
This function treats all elements after each keyword and before the next
keyword as its values, and each new keyword signifies the start of a new
sublist.
Example 1 (Property List):
Given the plist '(:a 1 :b 2 :c 3),
it will return '((:a 1) (:b 2) (:c 3)).
Example 2 (Key-Grouped List):
Given the list '(:a 1 2 3 :b 4 5),
it will return '((:a 1 2 3) (:b 4 5)).
Returns:
A list of sublists, each starting with a keyword."
;; Initialize result and current-list
(let ((result '())
(current-list '()))
;; Loop through each item in plist
(loop for item in lst
do (if (keywordp item) ; Check if item is a keyword
;; Start of new property list detected
(progn
;; Add current list to result if it is not empty
(when current-list
(push (nreverse current-list) result))
;; Reset current-list with the new keyword
(setq current-list (list item)))
;; Add item to the current property list
(push item current-list)))
;; Add remaining current-list to result
(when current-list
(push (nreverse current-list) result))
;; Return the reversed result list
(nreverse result)))
(defun resolve-input-type (type)
"Resolve the given input TYPE keyword to the corresponding HTML input type.
The function maps specific keywords to HTML input types. For example, it maps
\"single\" to \"radio\" and \"multiple\" to \"checkbox\". If the input TYPE
does not match these special cases, it is returned as-is.
TYPE: The input type keyword to resolve.
Returns:
The corresponding HTML input type string."
(cond ((string= type "single") "radio")
((string= type "multiple") "checkbox")
(t type)))
(declaim (ftype (function (choice) (values string list)) resolve-input-and-choice))
(defun resolve-input-and-choice (choice)
"Separate the input-type keyword from the remaining CHOICE in a list.
If the first element of CHOICE is a keyword, it is taken to be the input-type
keyword, and the rest of the list is taken to be the actual values.
CHOICE: The choice list, including an input type keyword.
Returns two values:
1. The input-type string if a keyword.
2. The remaining values in the list, excluding the input type keyword."
(let ((input-type-keyword (first choice)))
(if (keywordp input-type-keyword)
(values (resolve-input-type (string-downcase input-type-keyword)) (rest choice))
(error "A choice always starts with a input-type keyword"))))
(declaim (ftype (function (string string string) function) apply-input-form))
(defun apply-input-form (type group item)
"Apply the chosen input form function to generate HTML for a single form element.
TYPE: A string specifying the HTML input type like 'radio', 'checkbox', 'text',
etc.
GROUP: A string specifying the name attribute for the input elements.
ITEM: The particular choice item that this form element represents.
Returns:
The HTML form element generated for the ITEM."
(funcall (choose-input-form type) type group item))
(defun choose-input-form (type)
"Choose the appropriate function to generate the HTML form input based on TYPE.
TYPE: A string specifying the HTML input type like 'radio', 'checkbox', 'text',
etc.
Returns:
A function that can be used to generate the HTML form input. Or throws an error
if an unknown type is passed."
(typecase type
(checkable-element #'checkable)
(ctrl-element #'ctrl)
(otherwise (error "Unknown type ~A" type))))
(defmacro form (action &optional list-style-type &body body)
"This macro generates an HTML form composed of multiple questions.
ACTION: Specifies the URL where the form will be submitted. This should be a
string representing the URL path.
BODY: A series of questions. Each question should contain the keys :ask,
:group, and :choices. The first element of :choices should be a keyword
specifying the type of input elements (e.g. :radio), followed by a list of
answer options.
Example 1:
(form \"/submit\"
(:ask \"How old are you?\"
:group \"age\"
:choices (:radio \"18-24\" \"25-34\" \"35-44\")))
Example 2:
(form \"/submit\"
(:ask \"How old are you?\"
:group \"age\"
:choices (:single \"18-24\" \"25-34\" \"35-44\")))"
(let ((class-string (spacing :property "p" :side "y" :size 5)))
`(spinneret:with-html
(root (:class ,class-string :action ,action :method "post")
,@(loop for q in body
for (ask group choices) = (multiple-value-list (extract-question-components q))
collect `(:fieldset (:legend ,ask)
(:ol ,@(when list-style-type (list :style (format nil "list-style-type: ~a" list-style-type)))
,@(loop for choice in (split-list-by-keyword choices)
for (type values) = (multiple-value-list (resolve-input-and-choice choice))
collect `(progn ,@(loop for value in values
collect `(:li (apply-input-form ,type ,group ,value))))))))
(btn-primary (:type "submit")
(find-l10n "submit" spinneret:*html-lang* *l10n*))))))