diff --git a/src/brmelect.scm b/src/brmelect.scm index 8a97594..9458957 100644 --- a/src/brmelect.scm +++ b/src/brmelect.scm @@ -49,7 +49,10 @@ (else (message-body (car val)))))) (define (int-param parameters key) - (string->number (param parameters key))) + (let ((val (hash-table-ref/default parameters key 0))) + (cond + ((integer? val) val) + (else (string->number (message-body (car val))))))) (define (redirect url) (make-response @@ -147,16 +150,20 @@ (define-resource (meeting-votes "admin" "meeting" id params) (let ((meeting-info (query-db "SELECT title FROM brm.meetings WHERE meeting_id = $1" id)) (rows (query-db "SELECT vote_id,title,lower(open_time),upper(open_time),is_active FROM brm.votes WHERE meeting_id = $1 -ORDER BY vote_id" id))) +ORDER BY vote_id" id)) + (members (query-db "SELECT mm.member_id, m.nick, m.name, m.surname, mm.eligible, mm.present + FROM brm.meeting_member_status mm + JOIN brm.members m ON mm.member_id = m.member_id + WHERE mm.meeting_id = $1 + ORDER BY m.surname, m.name" id))) (make-html-response 200 (layout - (string-append "Meeting " (identity id) " - Votes") + (string-append "Meeting " id " - Votes") `@div{ @h2{@,(row-fold* (lambda (title x) title) "" meeting-info) - Votes} - @form[ - (action @,(string-append "/admin/meeting/" id "/vote")) - (method "POST")]{ + @form[(action @,(string-append "/admin/meeting/" id "/vote")) + (method "POST")]{ @table{ @tr{ @th{@label[(for "vote-title")]{New Vote Title}} @th{}} @tr{ @td{@input[(name "vote-title")]} @td{@input[(type "submit") (value "Create Vote")]}}}} @@ -174,8 +181,56 @@ ORDER BY vote_id" id))) }) rows) } + @h3{Members} + @form[(action @,(string-append "/admin/meeting/" id "/members")) + (method "POST")]{ + @table{ + @tr{ @th{ID} @th{Nickname} @th{Full Name} @th{Eligible} @th{Present} @th{Actions}} + @,@(row-map* + (lambda (member-id nick name surname eligible present) + `@tr{ + @td{@,(number->string member-id)} + @td{@,nick} + @td{@,(string-append name " " surname)} + @td{@input[(type "checkbox") (name "eligible_" (number->string member-id)) + (if (eq? eligible #t) "checked" "")]} + @td{@input[(type "checkbox") (name "present_" (number->string member-id)) + (if (eq? present #t) "checked" "")]} + @td{@input[(type "submit") (value "Update " (number->string member-id))]} + }) + members) + } + } })))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; /admin/meeting/:id/members +(define-resource (update-meeting-members "admin" "meeting" id "members" params) + (if (string=? (resource-context-method (current-resource-context)) "POST") + (let* ((all-member-rows (query-db "SELECT member_id, eligible, present FROM brm.meeting_member_status WHERE meeting_id = +$1" id)) + (member-updates + (for-each + (lambda (member-row) + (let* ((member-id (vector-ref member-row 0)) + (eligible-str (param params (string-append "eligible_" (number->string member-id)))) + (present-str (param params (string-append "present_" (number->string member-id))))) + (when member-id + (query-db "UPDATE brm.meeting_member_status SET eligible = $2, present = $3 WHERE member_id = $1 AND +meeting_id = $4" + member-id (if eligible-str #t #f) (if present-str #t #f) id)))) + all-member-rows))) + (make-html-response + 200 + (layout + "Members Updated" + `@div{ + @p{Members status updated successfully for meeting @,(identity id).} + @a[(href @,(string-append "/admin/meeting/" id))]{Back to Meeting} + })))) + (make-error-response + 405 "The access method used to request the document is not supported." + #:headers '(("Allow" . "POST")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /admin/meeting/:id/vote @@ -195,6 +250,106 @@ ORDER BY vote_id" id))) 405 "The access method used to request the document is not supported." #:headers '(("Allow" . "POST"))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; /admin/vote/:id +(define-resource (vote-details "admin" "vote" id params) + (let ((vote-info (query-db "SELECT v.title, m.title as meeting_title, lower(v.open_time), upper(v.open_time), v.is_active + FROM brm.votes v + JOIN brm.meetings m ON v.meeting_id = m.meeting_id + WHERE v.vote_id = $1" id)) + (members (query-db "SELECT vms.member_id, m.nick, m.name, m.surname, vms.eligible, vms.present + FROM brm.vote_member_status vms + JOIN brm.members m ON vms.member_id = m.member_id + WHERE vms.vote_id = $1 + ORDER BY m.surname, m.name" id))) + (make-html-response + 200 + (layout + "Vote Details" + `@div{ + @h2{Vote @,(identity id) Details} + @table{ + @tr{ @th{Title} @td{@,(row-fold* (lambda (title x) title) "" vote-info) }} + @tr{ @th{Meeting} @td{@,(row-fold* (lambda (meeting-title x) meeting-title) "" vote-info) }} + @tr{ @th{Start} @td{@,(row-fold* (lambda (start x) start) "" vote-info) }} + @tr{ @th{End} @td{@,(row-fold* (lambda (end x) end) "" vote-info) }} + @tr{ @th{Active} @td{@,(row-fold* (lambda (is-active x) (if (eq? is-active #t) "Yes" "No")) "" vote-info) }} + } + @form[(action @,(string-append "/admin/vote/" id "/end")) (method "POST")]{ + @input[(type "submit") (value "End Vote")] + } + @h3{Members} + @form[(action @,(string-append "/admin/vote/" id "/members")) (method "POST")]{ + @table{ + @tr{ @th{ID} @th{Nickname} @th{Full Name} @th{Eligible} @th{Present} @th{Actions}} + @,@(row-map* + (lambda (member-id nick name surname eligible present) + `@tr{ + @td{@,(number->string member-id)} + @td{@,nick} + @td{@,(string-append name " " surname)} + @td{@input[(type "checkbox") (name "eligible_" (number->string member-id)) + (if (eq? eligible #t) "checked" "")]} + @td{@input[(type "checkbox") (name "present_" (number->string member-id)) + (if (eq? present #t) "checked" "")]} + @td{@input[(type "submit") (value "Update " (number->string member-id))]} + }) + members) + } + } + })))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; /admin/vote/:id/members +(define-resource (update-vote-members "admin" "vote" id "members" params) + (if (string=? (resource-context-method (current-resource-context)) "POST") + (let* ((all-member-rows (query-db "SELECT member_id, eligible, present, meeting_id FROM brm.vote_member_status WHERE +vote_id = $1" id)) + (member-updates + (for-each + (lambda (member-row) + (let* ((member-id (vector-ref member-row 0)) + (meeting-id (vector-ref member-row 3)) + (eligible-str (param params (string-append "eligible_" (number->string member-id)))) + (present-str (param params (string-append "present_" (number->string member-id))))) + (when member-id + (query-db "UPDATE brm.vote_member_status SET eligible = $2, present = $3 WHERE member_id = $1 AND vote_id = +$4" + member-id (if eligible-str #t #f) (if present-str #t #f) id) + (when (and present-str (eq? (string=? (if (eq? (vector-ref member-row 3) #f) #t) #t)) + (query-db "SELECT brm.sync_vote_present_to_meeting($1, $2, $3)" + member-id meeting-id (if present-str #t #f)))))) + all-member-rows))) + (make-html-response + 200 + (layout + "Vote Members Updated" + `@div{ + @p{Members status updated successfully for vote @,(identity id).} + @a[(href @,(string-append "/admin/vote/" id))]{Back to Vote} + })))) + (make-error-response + 405 "The access method used to request the document is not supported." + #:headers '(("Allow" . "POST"))) )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; /admin/vote/:id/end +(define-resource (end-vote "admin" "vote" id "end" params) + (if (string=? (resource-context-method (current-resource-context)) "POST") + (begin + (query-db "UPDATE brm.votes SET is_active = FALSE WHERE vote_id = $1" id) + (make-html-response + 200 + (layout + "Vote Ended" + `@div{ + @p{Vote @,(identity id) has been ended successfully.} + @a[(href @,(string-append "/admin/vote/" id))]{Back to Vote} + })))) + (make-error-response + 405 "The access method used to request the document is not supported." + #:headers '(("Allow" . "POST")))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /foo -- debug endpoint (define-resource (foo-bar-baz "foo" id params)