path: root/emacsconf-schedule.el

;;; emacsconf-schedule.el --- Scheduling support     -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Sacha Chua

;; Author: Sacha Chua <sacha@sachachua.com>
;; Keywords: calendar

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; 

;;; Code:

(defvar emacsconf-schedule-strategies
  '(emacsconf-schedule-allocate-video-time-rounded-to-five)
  "List of scheduling functions.
Each function should take the info and manipulate it as needed, returning the new info.")

(defvar emacsconf-schedule-max-time 30)
(defun emacsconf-schedule-allocate-at-most (info)
  "Allocate at most `emacsconf-schedule-max-time' to the talks."
  (mapcar (lambda (o)
            (when (plist-get o :max-time)
              (plist-put o :time
                         (number-to-string
                          (min
                           (string-to-number (plist-get o :max-time))
                           emacsconf-max-time))))
            o)
          info))


(defvar emacsconf-schedule-break-time 10 "Number of minutes for break.")
(defvar emacsconf-schedule-lunch-time 45 "Number of minutes for lunch.")
(defvar emacsconf-schedule-start-time "09:00:00")
(defvar emacsconf-schedule-end-time "17:30:00")

(defun emacsconf-schedule-override-breaks (info)
  (mapcar (lambda (o)
            (when (string-match "BREAK" (or (plist-get o :title) ""))
              (plist-put o :time (number-to-string emacsconf-schedule-break-time)))
            (when (string-match "LUNCH" (or (plist-get o :title) ""))
              (plist-put o :time (number-to-string emacsconf-schedule-lunch-time)))
            o)
          info))

(defun emacsconf-schedule-prepare (&optional info)
	"Apply `emacsconf-schedule-strategies' to INFO to determine the schedule."
  (emacsconf-schedule-based-on-info
   (seq-reduce (lambda (prev val) (funcall val prev))
               emacsconf-schedule-strategies
               (or info (emacsconf-get-talk-info)))))

(defun emacsconf-schedule-summarize-breaks (&optional list)
  (setq list (or list (emacsconf-schedule-summarize)))
  (let ((list (or list (emacsconf-schedule-summarize)))
        (title-field 5))
    (append
     (cdr (seq-filter (lambda (o) (string-match "BREAK" (elt o title-field)))
                      list))
     '(hline)
     (cdr (seq-filter (lambda (o) (string-match "LUNCH" (elt o title-field)))
                 list)))))

(defun emacsconf-schedule-set-all-tracks-to-general (info)
	"Set all tracks to General."
	(mapcar (lambda (o) (plist-put o :track "General")) info))

(defun emacsconf-schedule-fix-start (info)
	"Make all talks fixed-time."
	(mapcar (lambda (o) (plist-put o :fixed-time t)) info))

(defvar emacsconf-schedule-default-buffer-minutes-for-dev 25)
(defun emacsconf-schedule-allow-extra-q-and-a-for-dev (info)
	"Set development time"
  (mapcar (lambda (o)
						(when (and (string= (plist-get o :track) "Development")
											 (string-match "live" (or (plist-get o :q-and-a) "")))
							(plist-put o :buffer (number-to-string emacsconf-schedule-default-buffer-minutes-for-dev)))
						o) info))

(defun emacsconf-schedule-strategy-pack-everything-in-just-as-confirmed (&optional info)
  (let* ((emacsconf-schedule-break-time 10)
         (emacsconf-schedule-lunch-time 30)
         (emacsconf-schedule-max-time 30)
         (emacsconf-schedule-default-buffer-minutes 5)
         (emacsconf-schedule-default-buffer-minutes-for-live-q-and-a 10)
         (emacsconf-schedule-tweaked-allocations '(("indieweb" . 20)
                                 ("maint" . 20)
                                 ("workflows" . 20)))
         (emacsconf-schedule-strategies '(emacsconf-schedule-allocate-buffer-time
                        emacsconf-schedule-override-breaks
                        emacsconf-schedule-allocate-buffer-time-at-most-max-time
                        emacsconf-schedule-allocate-max-time
                        emacsconf-schedule-allocate-at-most
                        emacsconf-schedule-tweak-allocations)))
    (emacsconf-schedule-prepare info)))

(defun emacsconf-schedule-copy-previous-track (info)
	"Use :set-track to update INFO."
	(cl-loop with track = (plist-get (car info) :set-track)
					 for talk in info
					 collect
					 (progn (when (plist-get talk :set-track)
										(setq track (plist-get talk :set-track)))
									(plist-put talk :track track))))

(defun emacsconf-schedule-allocate-buffer-time-at-most-max-time (info)
  (mapcar (lambda (o)
            (when (plist-get o :slug)
              (plist-put o :buffer
                         (number-to-string
                          (if (string-match "live" (or (plist-get o :q-and-a) ""))
                              (min (string-to-number (plist-get o :max-time))
                                   emacsconf-schedule-default-buffer-minutes-for-live-q-and-a)
                            emacsconf-schedule-default-buffer-minutes))))
            o)
          info))

(defun emacsconf-schedule-dump-sexp (info &optional include-time)
  (mapcar (lambda (o)
            (cond
             ((plist-get o :slug) (if include-time (cons (plist-get o :slug) (plist-get o :time)) (intern (plist-get o :slug))))
             ((plist-get o :fixed-time) (cons (plist-get o :title) (format-time-string "%Y-%m-%d %H:%M" (plist-get o :start-time))))
             (t (if include-time
                    (cons (plist-get o :title) (or (plist-get o :time) (plist-get o :max-time)))
                  (plist-get o :title)))))
          info))

(defun emacsconf-schedule-validate-and-summarize (schedule &optional info)
  (let ((validation-results (emacsconf-schedule-validate-time-constraints schedule info))
        (sched (emacsconf-schedule-summarize schedule)))
    (append
     (list (list (format "%d talks" (length (emacsconf-filter-talks arranged)))))
     (mapcar (lambda (o) (list nil nil nil nil nil o)) validation-results)
     (if show-breaks
         (append
          (emacsconf-summarize-schedule
           (seq-filter (lambda (o) (string-match "BREAK\\|LUNCH" (plist-get o :title)))
                       schedule))
          '(hline)))
     sched nil)))
(defun emacsconf-schedule-inflate-sexp (sequence &optional info include-time)
  "Takes a list of talk IDs and returns a list that includes the scheduling info.
Pairs with `emacsconf-schedule-dump-sexp'."
  (setq info (or info (emacsconf-get-talk-info)))
  (let ((by-assoc (mapcar (lambda (o) (cons (intern (plist-get o :slug)) o))
													(emacsconf-filter-talks info)))
        date)
    (mapcar
     (lambda (seq)
       (unless (listp seq) (setq seq (list seq)))
       
       (if include-time
           (error "Not yet implemented")
         (let ((start-prop (or (plist-get (cdr seq) :start)
                               (and (stringp (cdr seq)) (cdr seq))))
							 (buffer-prop (when (plist-get (cdr seq) :buffer)
															(number-to-string (plist-get (cdr seq) :buffer))))
               (time-prop (or (plist-get (cdr seq) :time) ; this is duration in minutes
                              (and (numberp (cdr seq)) (cdr seq))))
               (track-prop (plist-get (cdr seq) :track))
							 (set-track-prop (plist-get (cdr seq) :set-track)))
           (append
            ;; overriding 
            (when start-prop
              (if (string-match "-" start-prop)
                  (setq date (format-time-string "%Y-%m-%d" (date-to-time start-prop)))
                (setq start-prop  (concat date " " start-prop)))
              (list
               :scheduled (format-time-string (cdr org-time-stamp-formats) (date-to-time start-prop)
                                              emacsconf-timezone)
               :start-time (date-to-time start-prop)
               :fixed-time t))
						(when buffer-prop
							(list :buffer buffer-prop))
            (when track-prop
              (list :track track-prop))
						(when set-track-prop
              (list :set-track set-track-prop))
            (when time-prop
              (list :time (if (numberp time-prop) (number-to-string time-prop) time-prop)))
            ;; base entity
            (cond
             ((eq (car seq) 'lunch)
              (list :title "LUNCH" :time (number-to-string emacsconf-schedule-lunch-time)))
             ((eq (car seq) 'break)
              (list :title "BREAK" :time (number-to-string emacsconf-schedule-break-time)))
             ((symbolp (car seq))
              (assoc-default (car seq) by-assoc))
             ((stringp (car seq))
              (or (seq-find (lambda (o) (string= (plist-get o :title) (car seq))) info)
                  (list :title (car seq))))
             (t (error "Unknown %s" (prin1-to-string seq))))))))
     sequence)))

(defun emacsconf-format-schedule-summary-row (o)
  (pcase emacsconf-focus
    ('status
      (list
       (plist-get o :status)
       (if (plist-get o :slug)
           (org-link-make-string (plist-get o :url)
                                 (plist-get o :slug))
         "")
       (if (plist-get o :scheduled)
           (emacsconf-format-short-time (plist-get o :scheduled))
         "")
       (or (plist-get o :time) "")
       (or (plist-get o :buffer) "")
       (org-link-make-string (org-link-heading-search-string (plist-get o :title))
                             (plist-get o :title))
       (or (plist-get o :speakers) "")
       (or (plist-get o :q-and-a) "")
       (or (plist-get o :availability) "")))
    ('time
      (list
       (if (plist-get o :slug)
           (org-link-make-string (plist-get o :url) (plist-get o :slug))
         "------")
       (if (and (plist-get o :scheduled)
                (not (plist-get o :fixed-time)))
           (emacsconf-format-short-time (plist-get o :scheduled) t)
         "")
       (or (plist-get o :time) "")
       (or (plist-get o :buffer) "")
       (if (< (string-to-number (or (plist-get o :time) ""))
              (string-to-number (or (plist-get o :max-time) "")))
           (plist-get o :max-time)
         "")
       (org-link-make-string (org-link-heading-search-string (plist-get o :title))
                             (plist-get o :title))
       (if (plist-get o :scheduled) ; time is here twice so we can easily check it against availability
           (emacsconf-format-short-time (plist-get o :scheduled))
         "")
       (or (plist-get o :availability) "")))))

(defun emacsconf-schedule-summarize (&optional info)
  (cons
   (if (eq emacsconf-focus 'time)
       (list "Slug" "Schedule" "Time" "Buffer" "Max" "Title" "Time" "Availability")
     (list "Status" "Slug" "Schedule" "Time" "Buffer" "Title" "Name" "Q&A" "Availability"))
   (mapcar #'emacsconf-schedule-format-summary-row (or info (emacsconf-get-talk-info)))))

(defun emacsconf-schedule-update-from-info (info)
	(interactive (list (or emacsconf-schedule-draft (emacsconf-get-talk-info))))
  (save-window-excursion
    (save-excursion
      (mapc (lambda (talk)
              (emacsconf-go-to-talk (plist-get talk :slug))
              (org-entry-put (point) "SCHEDULED" (plist-get talk :scheduled))
              (org-entry-put (point) "TRACK" (plist-get talk :track))
              (org-entry-put (point) "TIME" (plist-get talk :time)))
            (emacsconf-filter-talks info)))))

(defun emacsconf-schedule-save-emailed-times (info &optional force)
	(interactive (list (or emacsconf-schedule-draft (emacsconf-get-talk-info)) current-prefix-arg))
	(save-window-excursion
    (save-excursion
      (mapc (lambda (talk)
              (emacsconf-go-to-talk (plist-get talk :slug))
							(when (and (plist-get talk :scheduled)
												 (or force (null (org-entry-get (point) "ORIGINAL_SCHEDULE"))))
								(org-entry-put (point) "ORIGINAL_SCHEDULE"
															 (replace-regexp-in-string "[<>]" "" (plist-get talk :scheduled)))))
            (emacsconf-filter-talks info)))))

(defvar emacsconf-schedule-svg-modify-functions '(emacsconf-schedule-svg-color-by-track) "Functions to run to modify the display of each item.")
(defvar emacsconf-use-absolute-url nil "Non-nil means try to use absolute URLs.")
(defun emacsconf-schedule-svg-track (svg base-x base-y width height start-time end-time info)
	"Draw the actual rectangles and text for the talks."
  (let ((scale (/ width (float-time (time-subtract end-time start-time)))))
    (mapc
     (lambda (o)
       (let* ((offset (floor (* scale (float-time (time-subtract (plist-get o :start-time) start-time)))))
              (size (floor (* scale (float-time (time-subtract (plist-get o :end-time) (plist-get o :start-time))))))
              (x (+ base-x offset))
              (y base-y)
              (node (dom-node
                     'rect
                     (list
                      (cons 'x x)
                      (cons 'y y)
                      (cons 'opacity "0.8")
                      (cons 'width size)
                      (cons 'height (1- height))
                      (cons 'stroke "black")
                      (cons 'stroke-dasharray
                            (if (string-match "live" (or (plist-get o :q-and-a) "live"))
                                ""
                              "5,5,5"))
                      (cons 'fill
                            (cond
                             ((string-match "BREAK\\|LUNCH" (plist-get o :title)) "white")
                             ((plist-get o :invalid) "red")
                             ((string-match "EST"
                                            (or (plist-get o :availability) ""))
                              "lightgray")
                             (t "lightgreen"))))))
              (parent (dom-node
                       'a
                       (list
                        (cons 'href
                              (concat
                               (if emacsconf-use-absolute-url
                                   emacsconf-base-url
                                 "/")
                               (plist-get o :url)))
                        (cons 'title (plist-get o :title))
                        (cons 'data-slug (plist-get o :slug)))
                       (dom-node 'title nil
                                 (concat (format-time-string "%l:%M-" (plist-get o :start-time) emacsconf-timezone)
                                         (format-time-string "%l:%M " (plist-get o :end-time) emacsconf-timezone)
                                         (plist-get o :title)))
                       node
                       (dom-node
                        'g
                        `((transform . ,(format "translate(%d,%d)"
                                                (+ x size -2) (+ y height -2))))
                        (dom-node
                         'text
                         (list
                          (cons 'fill "black")
                          (cons 'x 0)
                          (cons 'y 0)
                          (cons 'font-size 10)
                          (cons 'transform "rotate(-90)"))
                         (svg--encode-text (or (plist-get o :slug) (plist-get o :title))))))))
         (run-hook-with-args
          'emacsconf-schedule-svg-modify-functions
          o node parent)
         (dom-append-child
          svg
          parent)))
     info)))

(defun emacsconf-schedule-svg-day (elem label width height start end tracks)
	"Add the time scale and the talks on a given day."
  (let* ((label-margin 15)
         (track-height (/ (- height (* 2 label-margin)) (length tracks)))
         (x 0) (y label-margin)
         (scale (/ width (float-time (time-subtract end start))))
         (time start))
    (dom-append-child elem (dom-node 'title nil (concat "Schedule for " label)))
    (svg-rectangle elem 0 0 width height :fill "white")
    (svg-text elem label :x 3 :y (- label-margin 3) :fill "black" :font-size "10")
    (mapc (lambda (track)
            (emacsconf-schedule-svg-track
             elem x y width track-height
             start end track)
            (setq y (+ y track-height)))
          tracks)
    ;; draw grid
    (while (time-less-p time end)
      (let ((x (* (float-time (time-subtract time start)) scale)))
        (dom-append-child
         elem
         (dom-node
          'g
          `((transform . ,(format "translate(%d,%d)" x label-margin)))
          (dom-node
           'line
           `((stroke . "darkgray")
             (x1 . 0)
             (y1 . 0)
             (x2 . 0)
             (y2 . ,(- height label-margin label-margin))))
          (dom-node
           'text
           `((fill . "black")
             (x . 0)
             (y . ,(- height 2 label-margin))
             (font-size . 10)
             (text-anchor . "left"))
           (svg--encode-text (format-time-string "%-l %p" time emacsconf-timezone)))))
        (setq time (time-add time (seconds-to-time 3600)))))
    elem))

(defun emacsconf-schedule-svg-color-by-track (o node &optional parent)
	"Color sessions based on track."
  (let ((track (emacsconf-get-track (plist-get o :track))))
    (when track
      (dom-set-attribute node 'fill (plist-get track :color)))))

(defun emacsconf-schedule-svg-color-by-availability (o node &optional _)
	(dom-set-attribute node 'fill
										 (cond
											((string-match "^<" (or (plist-get o :availability) ""))
											 "lightblue")
											((string-match "^>" (or (plist-get o :availability) ""))
											 "peachpuff")
											(t "gray"))))

(defun emacsconf-schedule-svg (width height &optional info)
	"Make the schedule SVG for INFO."
  (setq info (or info (emacsconf-publish-prepare-for-display (emacsconf-get-talk-info))))
  (let ((days (seq-group-by (lambda (o)
                              (format-time-string "%Y-%m-%d" (plist-get o :start-time) emacsconf-timezone))
                            (sort (seq-filter (lambda (o)
                                                (or (plist-get o :slug)
                                                    (plist-get o :include-in-info)))
                                              info)
                                  #'emacsconf-sort-by-scheduled))))
    (emacsconf-schedule-svg-days
     width height
     (mapcar (lambda (o)
               (let ((start (concat (car o) "T" emacsconf-schedule-start-time emacsconf-timezone-offset))
                     (end (concat (car o) "T" emacsconf-schedule-end-time emacsconf-timezone-offset)))
                 (list :label (format-time-string "%A" (date-to-time (car o)))
                       :start start
                       :end end
                       :tracks (emacsconf-by-track (cdr o)))))
             days))))

(defun emacsconf-schedule-svg-color-by-status (o node &optional _)
	"Set talk color based on status.
Processing: palegoldenrod,
Waiting to be assigned a captioner: yellow,
Captioning in progress: lightgreen,
Ready to stream: green,
Other status: gray"
  (unless (plist-get o :invalid)
    (dom-set-attribute node 'fill
                       (pcase (plist-get o :status)
                         ((rx (or "TO_PROCESS"
                                  "PROCESSING"
                                  "TO_AUTOCAP"))
                          "palegoldenrod")
                         ("TO_ASSIGN"
                          "yellow")
                         ("TO_CAPTION"
                          "lightgreen")
                         ("TO_STREAM"
                          "green")
												 ("TODO"
													"lightgray")
                         (_ "gray")))))

(defun emacsconf-schedule-svg-days (width height days)
	"Display multiple days."
  (let ((svg (svg-create width height))
        (day-height (/ height (length days)))
        (y 0))
    (dom-append-child svg (dom-node 'title nil "Graphical view of the schedule"))
    (mapc
     (lambda (day)
       (let ((group (dom-node 'g `((transform . ,(format "translate(0,%d)" y))))))
         (dom-append-child svg group)
         (emacsconf-schedule-svg-day group
                   (plist-get day :label)
                   width day-height
                   (date-to-time (plist-get day :start))
                   (date-to-time (plist-get day :end))
                   (plist-get day :tracks)))
       (setq y (+ y day-height)))
     days)
    svg))

(defun emacsconf-schedule-get-subsequence (info start &optional end)
  "START and END are regexps to match against the title in INFO."
  (let ((start-position
         (and start
              (seq-position info start
                            (lambda (o match) (string-match match (plist-get o :title)))))))
    (seq-subseq info
                (or start-position 0)
                (if end
                    (+ (or start-position 0)
                       (seq-position (seq-subseq info (or start-position 0)) 
                                     end
                                     (lambda (o match) (string-match match (plist-get o :title)))))
                  (length info)))))

;;; Schedule summary

(defun emacsconf-schedule-round-start-to-five (info)
  (mapcar (lambda (o)
            (when (plist-get o :time)
              (let* ((start-time (plist-get o :start))
                     (decoded-time (decode-time start-time emacsconf-timezone))
                     (duration (* (string-to-number (plist-get o :time)) 60))
                     (minutes (elt decoded-time 1))
                     offset end-time)
                (unless (= (mod minutes 5) 0)
                  (setq offset (seconds-to-time (* 60 (- 5 (mod minutes 5))))
                        end-time (time-add start-time (time-to-seconds duration)))
                  (plist-put o :scheduled (format "%s-%s"
                                                  (format-time-string "%Y-%m-%d %H:%M" (time-add start-time offset))
                                                  (format-time-string "%H:%M" (time-add end-time offset))))
                  (plist-put o :start-time (time-add start-time offset))
                  (plist-put o :end-time (time-add end-time offset)))))
            o)
          info))

;(emacsconf-update-schedules #'emacsconf-round-start-to-five)
(defvar emacsconf-schedule-default-buffer-minutes-for-live-q-and-a 15)
(defvar emacsconf-schedule-default-buffer-minutes 5)
(defun emacsconf-schedule-allocate-buffer-time (info)
	"Allocate buffer time based on whether INFO has live Q&A.
Uses `emacsconf-schedule-default-buffer-minutes' and
`emacsconf-schedule-default-buffer-minutes-for-live-q-and-a'."
  (mapcar (lambda (o)
            (when (plist-get o :slug)
              (unless (plist-get o :buffer)
                (plist-put o :buffer
                           (number-to-string 
                            (if (string-match "live" (or (plist-get o :q-and-a) "live"))
                                emacsconf-schedule-default-buffer-minutes-for-live-q-and-a
                              emacsconf-schedule-default-buffer-minutes)))))
            o)
          info))

(defun emacsconf-schedule-allocate-video-time (info)
  (mapcar (lambda (o)
            (when (plist-get o :video-time)
              (plist-put o :time (plist-get o :video-time)))
            o)
          info))

(defun emacsconf-schedule-round-up-to (x y)
  "Return X rounded up to the nearest Y."
  (+ x (% (- y (% x y)) y)))
;; (assert (= (emacsconf-schedule-round-up-to 13 5) 15))
;; (assert (= (emacsconf-schedule-round-up-to 15 5) 15))
;; (assert (= (emacsconf-schedule-round-up-to 16 5) 20))

(defun emacsconf-schedule-allocate-video-time-round-up-to-five (info)
  (mapcar (lambda (o)       ; 1 + 4, 2 + 3, 3 + 2, 4 + 1, 0 + 0, 5 + 0
            (when (plist-get o :video-time)
              (plist-put o :time (number-to-string (emacsconf-schedule-round-up-to (string-to-number (plist-get o :video-time)) 5))))
            o)
          info))

(defun emacsconf-schedule-allocate-max-time (info)
  (mapcar (lambda (o)
            (when (plist-get o :max-time)
              (plist-put o :time (plist-get o :max-time)))
            o)
          info))

(defvar emacsconf-schedule-tweaked-allocations nil "Alist of slug . time")
(defun emacsconf-schedule-tweak-allocations (info)
  (mapcar (lambda (o)
            (let ((talk-times emacsconf-schedule-tweaked-allocations))
              (when (assoc (plist-get o :slug) emacsconf-schedule-tweaked-allocations)
                (plist-put o :time
                           (number-to-string
                            (assoc-default (plist-get o :slug) emacsconf-schedule-tweaked-allocations)))))
            o)
          info))

(defun emacsconf-schedule-based-on-info (info)
  (let (current-time end-time duration) 
    (mapcar
     (lambda (talk)
       (when (plist-get talk :fixed-time)
         (setq current-time (plist-get talk :start-time)))
       (when (and (plist-get talk :time) 
                  (not (string= (plist-get talk :status) "CANCELLED")))
         (setq duration (* (string-to-number (plist-get talk :time)) 60)
               end-time (time-add current-time (seconds-to-time duration)))
         (plist-put talk :scheduled
                    (format "<%s-%s>" (format-time-string "%Y-%m-%d %a %H:%M" current-time)
                            (format-time-string "%H:%M" end-time)))
         (plist-put talk :start-time current-time)
         (plist-put talk :end-time end-time)
         (setq current-time (time-add end-time (* (string-to-number (or (plist-get talk :buffer) "0")) 60))))
       talk)
     info)))

(defun emacsconf-schedule-update (&optional modify-func)
  "Schedule the talks based on TIME and BUFFER.
Talks with a FIXED_TIME property are not moved."
  (interactive)
  (save-excursion
    (org-with-wide-buffer
     (let (current-time end-time duration) 
       (org-map-entries
        (lambda ()
          (when (or (org-entry-get (point) "TIME") (org-entry-get (point) "FIXED_TIME"))
            (let ((talk (emacsconf-get-talk-info-for-subtree)))
              (when (org-entry-get (point) "FIXED_TIME")
                (setq current-time (plist-get talk :start-time)))
              (when (and (plist-get talk :time) 
                         (not (string= (plist-get talk :status) "CANCELLED")))
                (setq duration (* (string-to-number (plist-get talk :time)) 60)
                      end-time (time-add current-time (seconds-to-time duration)))
                (org-set-property "SCHEDULED" (format "%s-%s" (format-time-string "%Y-%m-%d %H:%M" current-time)
                                                      (format-time-string "%H:%M" end-time)))
                (when (functionp modify-func)
                  (funcall modify-func))
                (setq end-time (time-add (org-get-scheduled-time (point)) (seconds-to-time duration)))
                (setq current-time (time-add end-time (* (string-to-number (or (plist-get talk :buffer) "0")) 60))))))))))))

(defun emacsconf-schedule-get-key-func ()
	"Get the sorting key for the current entry."
	(org-entry-get (point) "SLUG"))
(defun emacsconf-schedule-sort-compare-func (a b)
	(let* ((entry-a (emacsconf-resolve-talk a emacsconf-schedule-draft))
				 (entry-b (emacsconf-resolve-talk b emacsconf-schedule-draft))
				 (track-index-a (or (seq-position emacsconf-tracks (emacsconf-get-track (plist-get entry-a :track))) 0))
				 (track-index-b (or (seq-position emacsconf-tracks (emacsconf-get-track (plist-get entry-b :track))) 0)))
		(cond
		 ((string= (plist-get entry-a :status) "CANCELLED") nil)
		 ((string= (plist-get entry-b :status) "CANCELLED") t)
		 ((< track-index-a track-index-b) t)
		 ((> track-index-a track-index-b) nil)
		 ((string< (plist-get entry-a :scheduled)
							 (plist-get entry-b :scheduled)) t)
		 (t nil))))
(defun emacsconf-schedule-sort-entries ()
	(interactive)
	(org-sort-entries nil ?f #'emacsconf-schedule-get-key-func #'emacsconf-schedule-sort-compare-func))

(defun emacsconf-schedule-validate-time-constraints (info &rest _)
  (interactive)
  (let* ((info (or info (emacsconf-get-talk-info)))
         (results (delq nil
                        (append
                         (mapcar
                          (lambda (o)
                            (apply #'emacsconf-schedule-check-time
                                   (car o)
                                   (emacsconf-search-talk-info (car o) info)
                                   (cdr o)))
                          emacsconf-time-constraints)
                         (mapcar
                          (lambda (o)
                            (let (result
                                  (constraint (emacsconf-schedule-get-time-constraint o)))
                              (when constraint
                                (setq result (apply #'emacsconf-schedule-check-time
                                                    (plist-get o :slug)
                                                    o
                                                    constraint))
                                (when result (plist-put o :invalid result))
                                result)))
                          info)))))
    (if (called-interactively-p 'any)
        (message "%s" (string-join results "\n"))
      results)))

(defun emacsconf-schedule-check-time (label o &optional from-time to-time day)
  "FROM-TIME and TO-TIME should be nil strings like HH:MM in EST.
DAY should be YYYY-MM-DD if specified.
Both start and end time are tested."
  (let* ((start-time (format-time-string "%H:%M" (plist-get o :start-time)))
         (end-time (format-time-string "%H:%M" (plist-get o :end-time)))
         result)
    (setq result
          (or
           (and (null o) (format "%s: Not found" label))
           (and from-time (string< start-time from-time)
                (format "%s: Starts at %s before %s" label start-time from-time))
           (and to-time (string< to-time end-time)
                (format "%s: Ends at %s after %s" label end-time to-time))
					 (and day
								(not (string= (format-time-string "%Y-%m-%d" (plist-get o :start-time))
															day))
								(format "%s: On %s instead of %s"
												label
												(format-time-string "%Y-%m-%d" (plist-get o :start-time))
												day))))
    (when result (plist-put o :invalid result))
    result))

(defun emacsconf-schedule-q-and-a-p (talk)
	"Return non-nil if TALK has a Q&A scheduled for the event."
	(not (string-match "after the event" (or (plist-get talk :q-and-a) ""))))
	
(defun emacsconf-schedule-get-time-constraint (o)
	(when (emacsconf-schedule-q-and-a-p o)
		(let ((avail (or (plist-get o :availability) ""))
					hours
					start
					(pos 0)
					(result (list nil nil nil)))
			(while (string-match "\\([<>]\\)=? *\\([0-9]+:[0-9]+\\) *EST" avail pos)
				(setf (elt result (if (string= (match-string 1 avail) ">")
															0
														1))
							(match-string 2 avail))
					(setq pos (match-end 0)))
			(when (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]" avail)
				(setf (elt result 2) (match-string 0 avail)))
			result)))

(defun emacsconf-schedule-rename-etc-timezone (s)
	"Change Etc/GMT-3 etc. to UTC+3 etc., since Etc uses negative signs and this is confusing."
	(cond ((string-match "Etc/GMT-\\(.*\\)" s) (concat "UTC+" (match-string 1 s)))
				((string-match "Etc/GMT\\+\\(.*\\)" s) (concat "UTC-" (match-string 1 s)))
				(t s)))

(defun emacsconf-schedule-format-time-constraint (constraints &optional include-offset local-timezone)
	"Format CONSTRAINTS for display."
	;; actually a talk object, extract constraints from it instead
	(when (not (= (length constraints) 3))
		(setq constraints (emacsconf-schedule-get-time-constraint constraints)))
	(string-join
	 (delq nil
				 (list
					(let ((start-time (car constraints))
								(end-time (cadr constraints))
								(start-local (and (car constraints)
																	local-timezone
																	(format-time-string
																	 "%H:%M"
																	 (date-to-time (concat emacsconf-date " " (car constraints) ":00 " emacsconf-timezone-offset))
																	 local-timezone)))
								(end-local (and (cadr constraints)
																local-timezone
																(format-time-string
																 "%H:%M"
																 (date-to-time (concat emacsconf-date " " (cadr constraints) ":00 " emacsconf-timezone-offset))
																 local-timezone))))
						(cond
						 ((and start-time end-time)
							(concat
							 (format "between %s-%s" start-time end-time)
							 (emacsconf-surround " " (and include-offset emacsconf-timezone-offset) "" "")
							 (if local-timezone
									 (format " (%s-%s %s)" start-local end-local (emacsconf-schedule-rename-etc-timezone local-timezone))
								 "")))
						 (start-time
							(concat
							 (format ">= %s" start-time)
							 (emacsconf-surround " " (and include-offset emacsconf-timezone-offset) "" "")
							 (if local-timezone
									 (format " (%s %s)" start-local (emacsconf-schedule-rename-etc-timezone local-timezone))
								 "")))
						 (end-time
							(concat
							 (format "<= %s" end-time)
							 (emacsconf-surround " " (and include-offset emacsconf-timezone-offset) "" "")
							 (if local-timezone
									 (format " (%s %s)" end-local (emacsconf-schedule-rename-etc-timezone local-timezone))
								 ""))))) 
					(if (elt constraints 2) (format "on %s" (elt constraints 2)))))
	 " and "))

(defun emacsconf-schedule-validate-all-talks-present (sched &optional list)
	(let* ((sched-slugs (mapcar (lambda (o) (plist-get o :slug))
															(emacsconf-filter-talks sched)))
				 (diff (delq
								nil
								(seq-difference
								 (mapcar
									(lambda (o) (plist-get o :slug))
									(seq-remove
									 (lambda (o)
										 (string= (plist-get o :status) "CANCELLED"))
									 (let ((emacsconf-talk-info-functions '(emacsconf-get-talk-info-from-properties)))
										 (or list (emacsconf-get-talk-info)))))
								 sched-slugs))))
		(when diff
			(list (concat "Missing talks: " (string-join diff ", "))))))

(defun emacsconf-schedule-validate-no-duplicates (sched &optional info)
  (let* ((sched-slugs (mapcar (lambda (o) (plist-get o :slug))
                              (emacsconf-filter-talks sched)))
         (dupes (seq-filter (lambda (o) (> (length (cdr o)) 1))
                            (seq-group-by #'identity sched-slugs))))
    (when dupes
      (list (concat "Duplicate talks: " (mapconcat 'car dupes ", "))))))

(defvar emacsconf-schedule-validation-functions '(emacsconf-schedule-validate-time-constraints
																emacsconf-schedule-validate-live-q-and-a-sessions-are-staggered
																emacsconf-schedule-validate-all-talks-present
																emacsconf-schedule-validate-no-duplicates))
(defun emacsconf-schedule-validate (sched &optional info)
	(seq-mapcat (lambda (func)
								(funcall func sched info))
							emacsconf-schedule-validation-functions))

(defun emacsconf-schedule-inflate-tracks (tracks schedule)
  (mapcar
   (lambda (day)
     (plist-put day :tracks
                (mapcar
                 (lambda (track)
                   (if (stringp track)
                       ;; track property
                       (seq-filter (lambda (o) (string= (or (plist-get o :track) (car (plist-get day :tracks)))
                                                        track))
                                   schedule)
                     ;; start and end regexp
                     (apply #'emacsconf-schedule-get-subsequence schedule (plist-get track :start) (plist-get track :end))))
                 (plist-get day :tracks)))
     day)
   tracks))

(defvar emacsconf-schedule-expected-talks nil "If non-nil, a list of slugs to validate against.")
(defmacro emacsconf-schedule-test (filename &rest varlist)
  "Write the proposed schedule to FILENAME using the variables in VARLIST.
If emacsconf-schedule-apply is non-nil, update `emacsconf-org-file' and the wiki."
  (declare (debug t))
  `(prog1
     (let* (,@varlist)
       (let* ((schedule (emacsconf-schedule-prepare arranged))
              (info (if emacsconf-schedule-expected-talks
                        (emacsconf-schedule-inflate-sexp emacsconf-schedule-expected-talks)
                      (emacsconf-get-talk-info)))
              (validation (or (emacsconf-schedule-validate schedule info) "")))
         (when (and (boundp 'emacsconf-schedule-apply) emacsconf-schedule-apply)
           (emacsconf-schedule-update-from-info schedule))
         (with-temp-file ,filename
           (svg-print (emacsconf-schedule-svg 800 400 schedule)))
         (clear-image-cache)
         (mapconcat (lambda (o) (format "- %s\n" o))
										validation
										;; (append validation (list (format "[[file:%s]]" filename)))
										)))
     (when (and (boundp 'emacsconf-schedule-apply) emacsconf-schedule-apply)
       (emacsconf-publish-before-pages)
       (emacsconf-publish-schedule)
       ;; (emacsconf-update-schedule)
       )))

(defun emacsconf-schedule-format-summary-row (o)
  (pcase emacsconf-focus
    ('status
      (list
       (plist-get o :status)
       (if (plist-get o :slug)
           (org-link-make-string (concat "https://emacsconf.org/" emacsconf-year "/talks/"
                                         (plist-get o :slug))
                                 (plist-get o :slug))
         "")
       (if (plist-get o :scheduled)
           (emacsconf-format-short-time (plist-get o :scheduled))
         "")
       (or (plist-get o :time) "")
       (or (plist-get o :buffer) "")
       (org-link-make-string (org-link-heading-search-string (plist-get o :title))
                             (plist-get o :title))
       (or (plist-get o :speakers) "")
       (or (plist-get o :q-and-a) "")
       (or (plist-get o :availability) "")))
    ('time
      (list
       (if (plist-get o :slug)
           (org-link-make-string (concat "https://emacsconf.org/" emacsconf-year "/talks/"
                                         (plist-get o :slug))
                                 (plist-get o :slug))
         "------")
       (if (plist-get o :scheduled)
           (format-time-string "%l:%M%#p" (plist-get o :start-time))
         "")
       (or (plist-get o :time) "")
       (or (plist-get o :buffer) "")
       (if (< (string-to-number (or (plist-get o :time) ""))
              (string-to-number (or (plist-get o :max-time) "")))
           (plist-get o :max-time)
         "")
       (org-link-make-string (org-link-heading-search-string (plist-get o :title))
                             (plist-get o :title))
       (if (plist-get o :scheduled) ; time is here twice so we can easily check it against availability
           (emacsconf-format-short-time (plist-get o :scheduled))
         "")
       (or (plist-get o :availability) "")))))

(defvar emacsconf-schedule-validate-live-q-and-a-sessions-buffer 5 "Number of minutes' allowance for a streamer to adjust audio and get set up.
Try to avoid overlapping the start of live Q&A sessions.")
(defun emacsconf-schedule-validate-live-q-and-a-sessions-are-staggered (schedule &rest _)
  "Try to avoid overlapping the start of live Q&A sessions.
Return nil if there are no errors."
  (when emacsconf-schedule-validate-live-q-and-a-sessions-buffer
    (let (last-end)
      (delq nil
            (mapcar (lambda (o)
                      (prog1
                          (when (and last-end
                                     (time-less-p
                                      (plist-get o :end-time)
                                      (time-add last-end (seconds-to-time (* emacsconf-schedule-validate-live-q-and-a-sessions-buffer 60)))))
                            (plist-put o :invalid (format "%s live Q&A starts at %s within %d minutes of previous live Q&A at %s"
                                                          (plist-get o :slug)
                                                          (format-time-string "%m-%d %-l:%M"
                                                                              (plist-get o :end-time))
                                                          emacsconf-schedule-validate-live-q-and-a-sessions-buffer
                                                          (format-time-string "%m-%d %-l:%M"
                                                                              last-end)))
                            (plist-get o :invalid))
                        (setq last-end (plist-get o :end-time))))
                    (sort 
                     (seq-filter (lambda (o) (string-match "live" (or (plist-get o :q-and-a) "")))
                                 schedule)
                     (lambda (a b)
                       (time-less-p (plist-get a :end-time) (plist-get b :end-time)))
                     ))))))
(defvar emacsconf-schedule-plan nil "Sequence of talks.")



(provide 'emacsconf-schedule)
;;; emacsconf-schedule.el ends here