cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make the form-horizontal-control procedure aware of hidden inputs

Browse source 
Signed-off-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Danjela Lura 2020-05-29 17:27:13 +02:00 • committed by Christopher Baines
parent ecd460867b
commit 14cd95f244
1 changed files with 125 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

240
guix-data-service/web/view/html.scm
View file

@ -133,123 +133,133 @@
(invalid-query-parameter? val)))) (invalid-query-parameter? val))))
(show-help-span? (show-help-span?
(or help-text has-error? required?))) (or help-text has-error? required?)))
`(div (if (string=? type "hidden")
(@ (class ,(string-append `(input (@ (class "form-control")
"form-group form-group-lg" (id ,input-id)
(if has-error? " has-error" "")))) (type ,type)
(label (@ (for ,input-id) (name ,input-name)
(class "col-sm-2 control-label")) ,@(match (assq (string->symbol input-name)
,label) query-parameters)
(div (#f '())
(@ (class "col-sm-9")) ((_key . value)
,(if options `((value ,(value->text value)))))))
`(select (@ (class "form-control") `(div
(style ,(if font-family (@ (class ,(string-append
(string-append "form-group form-group-lg"
"font-family: " font-family ";") (if has-error? " has-error" ""))))
"")) (label (@ (for ,input-id)
,@(if allow-selecting-multiple-options (class "col-sm-2 control-label"))
'((multiple #t)) ,label)
'()) (div
(id ,input-id) (@ (class "col-sm-9"))
,@(if show-help-span? ,(if options
`((aria-describedby ,help-span-id)) `(select (@ (class "form-control")
'()) (style ,(if font-family
(string-append
"font-family: " font-family ";")
""))
,@(if allow-selecting-multiple-options
'((multiple #t))
'())
(id ,input-id)
,@(if show-help-span?
`((aria-describedby ,help-span-id))
'())
(name ,input-name)) (name ,input-name))
,@(let ((selected-options ,@(let ((selected-options
(match (assq (string->symbol input-name) (match (assq (string->symbol input-name)
query-parameters) query-parameters)
((_key . value) ((_key . value)
(if (not allow-selecting-multiple-options) (if (not allow-selecting-multiple-options)
(list value) (list value)
value)) value))
(_ '())))) (_ '()))))
(map (match-lambda (map (match-lambda
((option-label . option-value) ((option-label . option-value)
`(option `(option
(@ ,@(if (member (if (and (@ ,@(if (member (if (and
(string? option-value) (string? option-value)
(string=? option-value (string=? option-value
null-string-value)) null-string-value))
"" ""
option-value) option-value)
selected-options) selected-options)
'((selected "")) '((selected ""))
'()) '())
(value ,option-value)) (value ,option-value))
,(value->text option-label))) ,(value->text option-label)))
(option-value (option-value
`(option `(option
(@ ,@(if (member (if (and (@ ,@(if (member (if (and
(string? option-value) (string? option-value)
(string=? option-value (string=? option-value
null-string-value)) null-string-value))
"" ""
option-value) option-value)
selected-options) selected-options)
'((selected "")) '((selected ""))
'())) '()))
,(value->text option-value)))) ,(value->text option-value))))
options))) options)))
`(input (@ (class "form-control") `(input (@ (class "form-control")
(style ,(if font-family (style ,(if font-family
(string-append (string-append
"font-family: " font-family ";") "font-family: " font-family ";")
"")) ""))
(id ,input-id) (id ,input-id)
(type ,type) (type ,type)
,@(if required? ,@(if required?
'((required #t)) '((required #t))
'()) '())
,@(if show-help-span? ,@(if show-help-span?
`((aria-describedby ,help-span-id)) `((aria-describedby ,help-span-id))
'()) '())
(name ,input-name) (name ,input-name)
,@(match (assq (string->symbol input-name) ,@(match (assq (string->symbol input-name)
query-parameters) query-parameters)
(#f '()) (#f '())
((_key . ($ <invalid-query-parameter> value)) ((_key . ($ <invalid-query-parameter> value))
(if (string=? type "checkbox") (if (string=? type "checkbox")
(if value (if value
'((checked #t)) '((checked #t))
'()) '())
`((value ,(value->text value))))) `((value ,(value->text value)))))
((_key . value) ((_key . value)
(if (string=? type "checkbox") (if (string=? type "checkbox")
(if value (if value
'((checked #t)) '((checked #t))
'()) '())
`((value ,(value->text value))))))))) `((value ,(value->text value)))))))))
,@(if show-help-span? ,@(if show-help-span?
`((span (@ (id ,help-span-id) `((span (@ (id ,help-span-id)
(class "help-block")) (class "help-block"))
,@(if has-error? ,@(if has-error?
(let* ((val (let* ((val
(assq-ref query-parameters (assq-ref query-parameters
(string->symbol input-name))) (string->symbol input-name)))
(messages (messages
(map invalid-query-parameter-message (map invalid-query-parameter-message
(if (list? val) (if (list? val)
val val
(list val))))) (list val)))))
`((p `((p
,@(if (null? messages) ,@(if (null? messages)
'(string "Error: invalid value") '(string "Error: invalid value")
(map (map
(lambda (message) (lambda (message)
`(strong `(strong
(@ (style "display: block;")) (@ (style "display: block;"))
,(string-append ,(string-append
"Error: " message))) "Error: " message)))
messages))))) messages)))))
'()) '())
,@(if required? '((strong "Required. ")) '()) ,@(if required? '((strong "Required. ")) '())
,@(if help-text ,@(if help-text
(list help-text) (list help-text)
'()))) '())))
'()))))) '()))))))
(define (readme contents) (define (readme contents)
(layout (layout