(module vandusen-poll ()

(import chicken scheme srfi-1 extras data-structures srfi-13)
(use vandusen irc)

(plugin 'poll
	(lambda ()
	  (define polls '())
	  (define all-choices '())
	  (define choice '(submatch (+ (~ #\,))))
	  (define all-votes '())

	  (command 'poll
		   `(: "poll" (+ space) (submatch (+ (~ #\:))) ":" (* space) (submatch (+ any)) (* space))
		   (lambda (m question choices)
		     (let ((choices  (map string-trim-both (string-split choices ",")))
			   (poll-idx (length polls)))

		       (set! polls (append polls (list (cons question choices))))
		       (set! all-choices (append all-choices (map (cut cons poll-idx <>) choices)))

		       (let* ((idx (iota (length choices) (add1 (- (length all-choices) (length choices)))))
			      (choices (map (cut format "~A) ~A" <> <>) idx choices))
			      (choices (string-intersperse choices ", ")))

			 (reply-to m (format "poll #~A is now open: ~A" (add1 poll-idx) choices) prefixed: #f)))))

	  (command 'vote
		   '(: "vote" (+ space) (submatch (+ any)))
		   (lambda (m choice)
		     (let* ((choice-idx (string->number choice)))
		       (if (and choice-idx (<= choice-idx (length all-choices)) (> choice-idx 0))
			   (let* ((choice-idx (sub1 choice-idx))
				  (voter      (string->symbol (car (irc:message-prefix m))))
				  (choice     (list-ref all-choices choice-idx))
				  (poll       (car choice))
				  (choice     (cdr choice))
				  (votes      (or (alist-ref poll all-votes) '())))
			     (set! all-votes (alist-update! poll (alist-update! voter choice-idx votes) all-votes))
			     (reply-to m (format "voted ~A" choice)))
			   (reply-to m (format "invalid choice: ~A" choice)))))
		   public: #t)
		  
	  (command 'poll-results
		   '(: "poll " (submatch (+ num)))
		   (lambda (m given-poll)
		     (unless (and-let* ((poll-idx (string->number given-poll))
					(poll-idx (and (<= poll-idx (length polls))
						       (> poll-idx 0)
						       (sub1 poll-idx)))
					(poll     (list-ref polls poll-idx))
					(votes    (or (alist-ref poll-idx all-votes) '()))
					(result   (fold (lambda (vote result)
							  (alist-update! (cdr vote) 
									 (add1 (alist-ref (cdr vote) result))
									 result))
							(filter-map (lambda (choice idx)
								      (and (= poll-idx (car choice)) (cons idx 0)))
								    all-choices
								    (iota (length all-choices)))
							votes))
					(result (map (lambda (r) 
						       (cons (cdr (list-ref all-choices (car r))) (cdr r)))
						     result))
					(result (sort result (lambda (a b) (> (cdr a) (cdr b)))))
					(result (map (lambda (r) (format "~A: ~A" (car r) (cdr r))) result))
					(result (string-intersperse result ", ")))
			       (reply-to m (conc (car poll) "\n" result) prefixed: #f))
				   
		       (reply-to m (format "unknown poll: ~A" given-poll)))))))

)