forked from brmlab/brmelect-github
fix more
This commit is contained in:
parent
5019188ed6
commit
5911221acb
1 changed files with 141 additions and 72 deletions
211
src/brmelect.scm
211
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue