;;; -*- lexical-binding: t -*-
(require 'derived)

(define-derived-mode grid-engine-list-mode
  tabulated-list-mode "Grid Engine"
  "Major mode for interacting with Grid Engine.
          \\{grid-engine-mode-list-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'grid-engine-list-mode)
  (setq mode-name "Grid Engine")
  (grid-engine--init-keymap)
  (grid-engine--init-header)

  (add-hook 'tabulated-list-revert-hook
            (lambda ()
              (grid-engine--init-header)
              (grid-engine-list-jobs)))
  (use-local-map grid-engine-list-mode-map)
  (run-hooks 'grid-engine-hook))

(defcustom grid-engine-host nil
  "The host on which Grid Engine is running.  Defaults to localhost.")
(defcustom grid-engine-qstat "/opt/sge/bin/lx-amd64/qstat"
  "The full path to the qstat executable.")
(defcustom grid-engine-user nil
  "The grid engine user.  Defaults to the logged in user's name.")
(defcustom grid-engine-column-order '(job-id time priority owner state)
  "The order of job columns to be displayed.  The following keys are valid: job-id, priority, name, owner, state, time, queue, slots.")

(defun grid-engine--init-keymap ()
  (setq grid-engine-list-mode-map (make-keymap))
  ;; disable all key bindings
  (suppress-keymap grid-engine-list-mode-map)
  (define-key grid-engine-list-mode-map (kbd "n") 'next-logical-line)
  (define-key grid-engine-list-mode-map (kbd "p") 'previous-logical-line)
  (define-key grid-engine-list-mode-map (kbd "q") 'bury-buffer)
  (define-key grid-engine-list-mode-map (kbd "g") 'revert-buffer)
  (define-key grid-engine-list-mode-map (kbd "<RET>")
    (lambda (&optional arg)
      (interactive "P")
      (let ((job (get-text-property (point) 'tabulated-list-id)))
        (unless job
          (error "[Grid Engine] point is not on a field of a job record"))
        (grid-engine-job-details job arg)))))

(defun grid-engine--init-header ()
  (grid-engine-update-list-format)
  (tabulated-list-init-header))

(defun grid-engine-update-list-format ()
  "Compute value of tabulated-list-format from grid-engine-column-order."
  (setq columns '((job-id   . ("Job-ID"   10 t))
                  (priority . ("Priority" 10 t))
                  (name     . ("Job name" 10 t))
                  (owner    . ("User"     15 t))
                  (state    . ("State"    15 t))
                  (time     . ("Time"     25 t))
                  (queue    . ("Queue"    25 t))
                  (slots    . ("Slots"    10 t))))
  (setq tabulated-list-format
        (vconcat (mapcar (lambda (key)
                           (cdr (assoc key columns)))
                         grid-engine-column-order))))

(defun grid-engine--raise-buffer (&optional buffer mode)
  (when buffer
    (set-buffer buffer))
  (goto-char (point-min))
  (pop-to-buffer-same-window (current-buffer))
  (when mode
    (funcall mode)))

(defun grid-engine--split-buffer (&optional buffer mode)
  (when buffer
    (set-buffer buffer))
  (goto-char (point-min))
  (display-buffer (current-buffer))
  (when mode
    (funcall mode)))

(defun grid-engine--default-directory ()
  (if grid-engine-host
      (concat "/ssh:" grid-engine-host ":")
    default-directory))

(defun grid-engine--cmd-to-buffer (cmd &optional buffer-name)
  "Run a command CMD on the Grid Engine host and write output to BUFFER-NAME.  If BUFFER-NAME is nil, write to current buffer."
  (let ((default-directory (grid-engine--default-directory)))
    (when buffer-name
      (set-buffer (get-buffer-create buffer-name))
      (erase-buffer))
    (process-file-shell-command cmd nil (current-buffer) t)))

(defun grid-engine--cmd-to-xmltree (cmd)
  "Run a command CMD on the Grid Engine host and return output as list of strings."
  (with-temp-buffer
    (grid-engine--cmd-to-buffer cmd)
    (libxml-parse-xml-region 1 (buffer-size))))

(defun grid-engine-list-jobs ()
  "List all jobs for the specified user in a new buffer."
  (defun field-as-text (field obj &optional format-string)
    (let* ((value (cdr (assoc field obj)))
           (format-string (if format-string format-string
                            "%s"))
           (text  (format format-string value)))
      (propertize text 'field value)))

  (defun job-to-row (job)
    (let ((contents (vconcat (mapcar (lambda (key)
                                       (field-as-text key job))
                                     grid-engine-column-order))))
      (list job contents)))

  (defun mkjob-alist (subtree)
    "Convert a parsed XML subtree for a job entry to an alist."
    (cl-reduce
     (lambda (acc field)
       (let ((name (case (car field)
                     ('JB_job_number  'job-id)
                     ('JAT_prio       'priority)
                     ('JB_name        'name)
                     ('JB_owner       'owner)
                     ('state          'state)
                     ('JAT_start_time 'time)
                     ('queue_name     'queue)
                     ('slots          'slots)
                     (t nil))))
         (if name
             (cons (cons name (caddr field)) acc)
           acc)))
     (cdr subtree) :initial-value nil))

  (let* ((user   (if grid-engine-user grid-engine-user
                   (user-login-name)))
         (cmd    (concat grid-engine-qstat " -xml -u " user))
         (title  "*grid-engine-jobs*"))
    (message "[Grid Engine] fetching list of jobs for %s ..." user)
    (let* ((tree (grid-engine--cmd-to-xmltree cmd))
           (jobs (mapcar 'mkjob-alist (cddr (caddr tree)))))
      (set-buffer (get-buffer-create title))
      (setq tabulated-list-entries
            (mapcar (lambda (job)
                      (job-to-row job))
                    jobs)))
    (grid-engine--raise-buffer nil 'grid-engine-list-mode)
    ;; update list
    (tabulated-list-print)
    (message nil)))

(defun grid-engine-job-details (job &optional new-buffer)
  (let* ((job-id (cdr (assoc 'job-id job)))
         (cmd    (concat grid-engine-qstat " -j " job-id))
         (title  (if new-buffer
                     (concat "*grid-engine-job-details-" job-id "*")
                   "*grid-engine-job-details*")))
    (message "[Grid Engine] fetching details for job %s" job-id)
    (grid-engine--cmd-to-buffer cmd title)
    (grid-engine--split-buffer)))

(provide 'grid-engine-mode)