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

Add support for select elements to form-horizontal-control

Browse source
This commit is contained in:
Christopher Baines 2019-05-11 20:36:37 +01:00
parent 94e321ec38
commit 512a583fa7
1 changed files with 78 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -96,9 +96,13 @@
(define* (form-horizontal-control label query-parameters (define* (form-horizontal-control label query-parameters
#:key help-text (required? #f)) #:key
help-text
required?
options)
(define (value->text value) (define (value->text value)
(match value (match value
(#f "")
((? date? date) ((? date? date)
(date->string date "~1 ~3")) (date->string date "~1 ~3"))
(other other))) (other other)))
@ -111,21 +115,49 @@
(string-downcase label))) (string-downcase label)))
(has-error? (invalid-query-parameter? (has-error? (invalid-query-parameter?
(assq-ref query-parameters (assq-ref query-parameters
(string->symbol input-name))))) (string->symbol input-name))))
`(div (@ (class ,(string-append (show-help-span?
(or help-text has-error? required?)))
`(div
(@ (class ,(string-append
"form-group form-group-lg" "form-group form-group-lg"
(if has-error? " has-error" "")))) (if has-error? " has-error" ""))))
(label (@ (for ,input-id) (label (@ (for ,input-id)
(class "col-sm-2 control-label")) (class "col-sm-2 control-label"))
,label) ,label)
(div (@ (class "col-sm-9")) (div
(input (@ (class "form-control") (@ (class "col-sm-9"))
,(if options
`(select (@ (class "form-control")
(style "font-family: monospace;")
(multiple #t)
(id ,input-id)
,@(if show-help-span?
`((aria-describedby ,help-span-id))
'())
(name ,input-name))
,@(let ((selected-options
(match (assq (string->symbol input-name)
query-parameters)
((_key . value)
value)
(_ '()))))
(map (lambda (option-value)
`(option
(@ ,@(if (member option-value selected-options)
'((selected ""))
'()))
,(value->text option-value)))
options)))
`(input (@ (class "form-control")
(style "font-family: monospace;") (style "font-family: monospace;")
(id ,input-id) (id ,input-id)
,@(if required? ,@(if required?
'((required #t)) '((required #t))
'()) '())
,@(if help-text ,@(if show-help-span?
`((aria-describedby ,help-span-id)) `((aria-describedby ,help-span-id))
'()) '())
(name ,input-name) (name ,input-name)
@ -135,11 +167,10 @@
((_key . ($ <invalid-query-parameter> value)) ((_key . ($ <invalid-query-parameter> value))
`((value ,(value->text value)))) `((value ,(value->text value))))
((_key . value) ((_key . value)
`((value ,(value->text value))))))) `((value ,(value->text value))))))))
,@(if (or help-text has-error? required?) ,@(if show-help-span?
`((span (@ (id ,help-span-id) `((span (@ (id ,help-span-id)
(class "help-block")) (class "help-block"))
,@(if required? '((strong "Required.")) '())
,@(if has-error? ,@(if has-error?
(let ((message (let ((message
(invalid-query-parameter-message (invalid-query-parameter-message
@ -152,6 +183,7 @@
message message
"invalid value.")))))) "invalid value."))))))
'()) '())
,@(if required? '((strong "Required. ")) '())
,@(if help-text ,@(if help-text
(list help-text) (list help-text)
'()))) '())))