forked from brmlab/brmelect-github
more code
This commit is contained in:
parent
c4356a9693
commit
dfd1d76446
1 changed files with 161 additions and 6 deletions
167
src/brmelect.scm
167
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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue