From 5911221acbab999a329b057061799bb0927d08d8 Mon Sep 17 00:00:00 2001 From: TMA Date: Sun, 15 Mar 2026 13:22:51 +0100 Subject: [PATCH] fix more --- src/brmelect.scm | 213 +++++++++++++++++++++++++++++++---------------- 1 file changed, 141 insertions(+), 72 deletions(-) diff --git a/src/brmelect.scm b/src/brmelect.scm index 5ff170f..f6467eb 100644 --- a/src/brmelect.scm +++ b/src/brmelect.scm @@ -59,6 +59,17 @@ code: 302 headers: `((location . ,url)))) +(define-syntax define-resource-POST + (syntax-rules () + ((_ (name step/arg ... parameters) + expr ...) + (define-resource (name step/arg ... parameters) + (if (string=? (resource-context-method (current-resource-context)) "POST") + (begin expr ...) + (make-error-response + 405 "The access method used to request the document is not supported." + #:headers '(("Allow" . "POST")))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; navigation menu (define (layout title . body) @@ -144,6 +155,74 @@ })))) ;@td{,(->string from)} +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; /admin/votes ; obsolete +;(define-resource (votes "admin" "votes" parameters) +; (let ((rows +; (query-db +; "SELECT vote_id,meeting_id,title,opens_at,closes_at,is_active FROM brm.votes ORDER BY vote_id"))) +; (make-html-response +; 200 +; (layout +; "Votes" +; `@div{ +; @a[href: "/votes/add"]{"Create Vote"} +; @table{ +; @tr{ +; @th{"ID"} +; @th{"Meeting"} +; @th{"Name"} +; @th{"Opens"} +; @th{"Closes"} +; @th{"Active"} +; } +; ,@(row-map +; (lambda (r) +; `@tr{ +; @td{,(number->string (vector-ref r 0))} +; @td{,(number->string (vector-ref r 1))} +; @td{,(vector-ref r 2)} +; @td{,(->string (vector-ref r 3))} +; @td{,(->string (vector-ref r 4))} +; @td{,(if (vector-ref r 5) "yes" "no")} +; }) +; rows) +; } +; })))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; /elect/status ; obsolete +;(define-resource (status "elect" "status" parameters) +; (let* ((vote (int-param parameters 'vote_id)) +; (rows +; (query-db +; "SELECT m.member_id,m.nick,s.in_debt,s.short_tenure,s.eligible +; FROM brm.member_status s +; JOIN brm.members m USING(member_id) +; WHERE vote_id=$1 +; ORDER BY m.member_id" +; vote))) +; (make-html-response +; 200 +; (layout +; "Member Status" +; `@table{ +; @tr{ +; @th{"Member"} +; @th{"Debt"} +; @th{"Short Tenure"} +; @th{"Eligible"} +; } +; ,@(row-map +; (lambda (r) +; `@tr{ +; @td{,(vector-ref r 1)} +; @td{,(if (vector-ref r 2) "yes" "no")} +; @td{,(if (vector-ref r 3) "yes" "no")} +; @td{,(if (vector-ref r 4) "yes" "no")} +; }) +; rows) +; })))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /admin/meeting/:id @@ -205,50 +284,41 @@ ORDER BY vote_id" id)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /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"))))) +(define-resource-POST (update-meeting-members "admin" "meeting" id "members" params) + (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} + })))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /admin/meeting/:id/vote -(define-resource (create-meeting-vote "admin" "meeting" id "vote" params) - (if (string=? (resource-context-method (current-resource-context)) "POST") - (let ((title (param params "vote-title"))) - (query-db "SELECT brm.create_vote_and_init_status($1, $2)" id title) - (make-html-response - 200 - (layout - "Vote Created" - `@div{ - @p{Vote successfully created 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"))))) +(define-resource-POST (create-meeting-vote "admin" "meeting" id "vote" params) + (let ((title (param params "vote-title"))) + (query-db "SELECT brm.create_vote_and_init_status($1, $2)" id title) + (make-html-response + 200 + (layout + "Vote Created" + `@div{ + @p{Vote successfully created for meeting @,(identity id).} + @a[(href @,(string-append "/admin/meeting/" id))]{Back to Meeting} + })))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /admin/vote/:id @@ -301,36 +371,35 @@ meeting_id = $4" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /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"))))) +(define-resource-POST (update-vote-members "admin" "vote" id "members" params) + (let* ((all-member-rows (query-db "SELECT member_id, eligible, present, meeting_id FROM brm.vote_member_status WHERE +vote_id = $1" id))) + ;(row-for-each* + ; (lambda (member-id eligible present meeting-id) + ; (let* ((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} + @table{@tr{@th{member-id}@th{eligible-str}@th{present-str}} + @,@(row-map* + (lambda (member-id eligible present meeting-id) + (let* ((eligible-str (param params (string-append "eligible_" (number->string member-id)))) + (present-str (param params (string-append "present_" (number->string member-id))))) + `@tr{@td{@,(number->string member-id)}@td{@,eligible-str}@td{@,present-str}})) + all-member-rows) + }})))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; /admin/vote/:id/end @@ -416,7 +485,7 @@ $4" } } })) - + (define brmelect-style "p, li { font-family: monospace; } #ballot { margin-left: auto; margin-right: auto; border: 1pt solid; width: 20em; padding: 1ex 1em; }