;;; lava-job-list-mode --- A major mode for interacting with lists of LAVA jobs
;;
;; Copyright (C) 2014 Alex Bennée

;; Author: Alex Bennée <alex.bennee@linaro.org>
;; Maintainer: Alex Bennée <alex.bennee@linaro.org>
;; Version: 0.1
;; Homepage: http://git.linaro.org/alex.bennee/

;; This file is not part of GNU Emacs.

;; This file 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, or (at your option)
;; any later version.

;; This file 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 <http://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;; This provides basic interaction with a list of LAVA jobs
;;
;;; Code:
;; uncomment to debug
;; (setq debug-on-error t)
;; (setq edebug-all-defs t)

;; Require prerequisites
(require 'lava-rpc)
(require 'lava-jobs)
(require 'lava-log-mode)
(require 'dash)
(require 'popup)

;; Variables
(defvar lava-job-list-mode-time-format
  "%H:%M %d/%m"
  "Time format used to display time, see `format-time-string'")

;;; Mode magic
(defvar lava-job-list-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map tabulated-list-mode-map)
    (define-key map (kbd "RET") 'lava-job-visit-results)
    (define-key map (kbd "d") 'lava-job-get-definition)
    (define-key map (kbd "r") 'lava-job-download-results)
    (define-key map (kbd "a") 'lava-job-add-job)
    (define-key map (kbd "k") 'lava-job-remove-job)
    (define-key map (kbd "g") 'lava-job-refresh-now)
    (define-key map (kbd "v") 'lava-job-popup-info)
    map)
  "Local keymap for `lava-job-list-mode' buffers.")

;;###autoload
(define-derived-mode lava-job-list-mode tabulated-list-mode "LAVA Job List"
  "Major mode for listing the LAVA jobs submitted by lava-mode.
The Buffer Menu is invoked by the commands \\[lava-list-jobs].

Letters do not insert themselves; instead, they are commands.
\\<lava-job-list-mode-map>
\\{lava-job-list-mode-map}"
  :lighter " LVJBS"
  (setq tabulated-list-format [("Job ID" 8 t)
                               ("Description" 40 t)
                               ("Last update" 15 nil :right-align)
                               ("Status" 10 nil :right-align)
                               ("Bundle" 15 nil)
                               ("Results URL" 20 nil)])
  (setq tabulated-list-use-header-line 't)
  (setq tabulated-list-sort-key nil)
  (message "setup mode")
  (add-hook 'tabulated-list-revert-hook 'lava-job-list--refresh nil t)
  (message "initialising header")
  (tabulated-list-init-header))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; List LAVA Jobs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun lava-job-list--buffer ()
  "Return a buffer to process the lava job list."
  (let ((host lava-host)
        (user lava-user-name)
        (token lava-api-token)
        (job-buffer
         (get-buffer-create
          (format "*LAVA Job List for %s*" lava-host))))
    (with-current-buffer job-buffer
      (setq lava-host host
            lava-user-name user
            lava-api-token token))
    job-buffer))

(defun lava-update-job-status (jobid resp)
  "Process RESP for JOBID."
  (let ((info-hash (lava-jobs-get-hash jobid))
        (status-changed nil))
    (-each (-map 'car resp)
      (lambda (key)
        (let ((value (cdr (assoc key resp)))
              (old-value (gethash key info-hash)))
          (when (not (equal value old-value))
            (setq status-changed
                  (puthash key value info-hash))))))
    (when status-changed
      (puthash "updated" (current-time) info-hash)
      (with-current-buffer (lava-job-list--buffer)
        (revert-buffer)))))

(defun lava-job-status (jobid)
  "Request the job status of JOBID."
  (lexical-let ((jobid jobid)
                (lava-host (lava-jobs-get-field jobid "lava_host")))
    (lava-xml-async-rpc-call #'(lambda (resp) (lava-update-job-status jobid resp))
                             'scheduler.job_status
                             jobid)))


(defun lava-job-list-get-details (job)
  "Request the details of a job."
  (let* ((info-hash (lava-jobs-get-hash job))
         (job-id (gethash "job_id" info-hash)))
  (lexical-let ((j job-id))
    (lava-xml-async-rpc-call #'(lambda (resp) (lava-update-job-status j resp))
                             'scheduler.job_details
                             j))))

(defun lava-stop-polling-job (job)
  "Stop polling the given LAVA job."
  (let* ((info-hash (lava-jobs-get-hash job))
         (timer (gethash "timer" info-hash)))
    (when (timerp timer)
      (cancel-timer timer)
      (puthash "timer" "cancelled" info-hash))))

(defun lava-start-polling-job (job)
  "Maybe start polling Lava for a given JOB status."
  (let* ((info-hash (lava-jobs-get-hash job))
         (existing-timer (gethash "timer" info-hash))
         (job-id (gethash "job_id" info-hash)))
    (unless (and existing-timer
                 (-contains? timer-idle-list existing-timer))
      (let* ((period (+ 15 (random (* 2 (length lava-job-info)))))
             (new-timer (run-with-idle-timer
                         period t 'lava-job-status job-id)))
        (puthash "timer" new-timer info-hash)
        (message
         "lava-start-polling-job: polling %s every %d" job-id period)))))

(defun lava-job-list-update-all ()
  "Update the info hash of all jobs now."
  (-each (lava-jobs-get-all-on-host lava-host)
    (lambda (job)
      (let* ((info-hash (lava-jobs-get-hash job))
             (jobid (gethash "job_id" info-hash)))
        (lava-job-status jobid)
        (unless (gethash "actual_device_id" info-hash)
          (lava-job-list-get-details jobid))))))

(defun lava-job-list--format-row (job)
  "Format a row of `JOB' for `tabulated-list-entries'."
  (let ((info-hash (lava-jobs-get-hash job)))
    (vector (format "%s" (gethash "job_id" info-hash))
            (or (gethash "description" info-hash)
                "unknown")
            ;; updated
            (format-time-string
              lava-job-list-mode-time-format
              (gethash "updated" info-hash))
            ;; status
            (or
             (gethash "job_status" info-hash)
             "Unknown")
            ;;
            (or
             (gethash "bundle_sha1" info-hash)
             "Unknown")
            ;; link to results
            (format
             "http://%s/scheduler/job/%s"
             lava-host (gethash "job_id" info-hash)))))

(defun lava-job-list--refresh ()
  "Refresh the list of `JOBS' in the display."
  (with-current-buffer (lava-job-list--buffer)
    (let (entries '())
      (-each (lava-jobs-get-all-on-host lava-host)
        (lambda (job)
          (lava-start-polling-job job)
          (add-to-list 'entries `(,job ,(lava-job-list--format-row job)))))
      (setq tabulated-list-entries entries))
    (tabulated-list-init-header)
    (tabulated-list-print)))

(defun lava-job-list--make-buffer ()
  "Return a buffer named \"*LAVA Job List*\"."
  (let ((buffer (lava-job-list--buffer)))
    (with-current-buffer buffer
      (lava-job-list-mode)
      (lava-job-list-update-all)
      (lava-job-list--refresh))
    buffer))

(defun lava-job-visit-results ()
  "Visit the results in the browser."
  (interactive)
  (let* ((ref (tabulated-list-get-id))
	 (entry (and ref (assq ref tabulated-list-entries)))
         (url (aref (car (cdr entry)) 5)))
    (browse-url url)))

(defun lava-job-remove-job ()
  "Remove the current job from the list of tracked jobs."
  (interactive)
  (let ((ref (tabulated-list-get-id)))
    (lava-stop-polling-job ref)
    (lava-jobs-delete-hash ref))
  (lava-job-list--refresh))

(defun lava-job-add-job (job-id)
  "Add `JOB-ID' to the list of tracked jobs."
  (interactive "nNumeric Job ID:")
  (lava-jobs-create-hash job-id "Manual")
  (lava-job-list--refresh))

(defun lava-job-download-results()
  "Download the results log into a temp buffer."
  (interactive)
  (lexical-let* ((ref (tabulated-list-get-id))
                 (info-hash (lava-jobs-get-hash ref))
                 (job-id (gethash "job_id" info-hash))
                 (job-log (format "http://%s/scheduler/job/%s/log_file/plain"
                                  lava-host job-id)))
    (url-retrieve
     job-log
     #'(lambda(status)
         (let ((log-data))
           (save-excursion
             (setq log-data (buffer-string)))
           (switch-to-buffer
            (get-buffer-create
             (format "*Job %s (%s) Results*"
                     job-id
                     (or (gethash "description" info-hash)
                         "no description"))))
           (insert log-data)
           (lava-log-mode))))))

(defun lava-job-refresh-now()
  "Refresh the JOBS view now."
  (interactive)
  (when (derived-mode-p 'lava-job-list-mode)
    (lava-job-list-update-all)
    (lava-job-list--refresh)))


(defun lava-job-popup-info ()
  "Display the information in the info hash as a pop-up."
  (interactive)
  (let* ((ref (tabulated-list-get-id))
         (info-hash (lava-jobs-get-hash ref))
         (popup))
    (let ((updated (gethash "updated" info-hash)))
      (when updated
        (setq popup
              (concat popup
                      "Updated at "
                      (format-time-string
                       lava-job-list-mode-time-format updated)))))
    (popup-tip popup)))

(defun lava-job--definition-buffer(id)
  (format "*Definition of LAVA Job %s*" id))

(defun lava-job--grab-definition(status id)
  "Copy contents of current buffer (in callback) to real definition."
  (let ((data-buffer (current-buffer))
        (final-buffer (get-buffer-create (lava-job--definition-buffer id)))
        (data))
    (with-current-buffer data-buffer
      (goto-char (point-min))
      (re-search-forward "{")
      (beginning-of-line)
      (set 'data
           (buffer-substring-no-properties (point) (point-max))))
    (with-current-buffer final-buffer
      (insert data)
      (not-modified)
      (lava-mode))
    (switch-to-buffer final-buffer)))

(defun lava-job-get-definition()
  "Fetch the definition for a given LAVA job."
  (interactive)
  (let* ((ref (tabulated-list-get-id))
         (info-hash (lava-jobs-get-hash ref))
         (job-id (gethash "job_id" info-hash))
         (def-buf (lava-job--definition-buffer job-id)))
    (if (get-buffer def-buf)
        (switch-to-buffer def-buf)
      (let ((job-def-url (format
                          "scheduler/job/%s/definition/plain" job-id)))
        (lava-rpc-fetch-url job-def-url 'lava-job--grab-definition `(,job-id))))))


;;;###autoload
(defun lava-list-jobs ()
  "Display the current list of submitted LAVA jobs."
  (interactive)
  (switch-to-buffer (lava-job-list--make-buffer)))

(provide 'lava-job-list-mode)
;;; lava-list-mode.el ends here