(defpackage list-manual-sleep-locks
  (:use :cl)
  (:export #:toplevel))

(in-package :list-manual-sleep-locks)

(defclass running-lock ()
  ((start-time :type integer
               :accessor running-lock-start-time
               :initarg :start-time
               :initform 0
               :documentation "The start time of the lock in microseconds. This
is relative to the CLOCK_MONOTONIC clock id.")
   (length :type (or integer null)
           :accessor running-lock-length
           :initarg :length
           :initform 0
           :documentation "The length of the lock in microseconds. A value of
nil means forever."))
  (:documentation "An object representing a running lock."))

(defun monotonic-microseconds ()
  "Return the value of the CLOCK_MONOTONIC clock in microseconds."
  (multiple-value-bind (sec nanosec)
      (sb-unix:clock-gettime sb-unix:clock-monotonic)
    (+ (* sec 1000 1000)
       (floor (/ nanosec 1000)))))

(defun lock-microseconds-left (lock &key (from (monotonic-microseconds)))
  "Return the number of microseconds left in LOCK. FROM is the point in time
from which to calculate."
  (with-slots (start-time length) lock
    (when length
      (- (+ start-time length) from))))

(defun format-seconds (seconds)
  "Return a string representing SECONDS in a human readable way."
  (if (zerop seconds)
      "0s"
      (let* ((days (floor (/ (abs seconds) 24 60 60)))
             (hours (floor (/ (- (abs seconds) (* days 24 60 60)) 60 60)))
             (mins (floor (/ (- (abs seconds)
                                (* hours 60 60)
                                (* days 24 60 60))
                             60)))
             (secs (- (abs seconds) (* mins 60)
                      (* hours 60 60) (* days 24 60 60))))
        (format nil
                "~@[~*-~]~[~:;~:*~Sd~]~[~:;~:*~Sh~]~[~:;~:*~Sm~]~[~:;~:*~Ss~]"
                (minusp seconds) days hours mins secs))))

(defun split-key-value-line (line)
  "Split LINE, in the form of key=vale, into a list of (key value)."
  (let ((index (position #\= line :test #'eql)))
    (list (subseq line 0 index)
          (subseq line (1+ index)))))

(defun systemd-unescape (str &key (start 0) (end (length str)))
  "Act as sytemd-escape --unescape (for non-path strings) for STR."
  (with-output-to-string (stream)
    (let ((copy-start start))
      (flet ((copy-to-output (i skip)
               (when (<= copy-start end)
                 (write-string str stream :start copy-start :end i)
                 (setq copy-start (+ i skip)))))
        (loop for i upfrom start below end
              for c = (aref str i)
              when (and (eql c #\\) (>= (- end i) 4)
                        (eql (aref str (1+ i)) #\x))
                do (copy-to-output i 4)
                and do (write-char (code-char (parse-integer str
                                                             :start (+ i 2)
                                                             :end (+ i 4)
                                                             :radix 16))
                                   stream))
        (copy-to-output end 0)))))

(defun extract-lock-length-string-from-service-name (name)
  "Extract the lock length string from a service name NAME of the form
\"NAME@TIME.service\"."
  (let ((start-idx (1+ (position #\@ name)))
        (end-idx (when (uiop:string-suffix-p name ".service")
                   (- (length name) (length ".service")))))
    (systemd-unescape name :start start-idx :end end-idx)))

(defparameter *lock-length-string-units*
  `((#\d . ,(* 24 60 60 1000 1000))
    (#\h . ,(* 60 60 1000 1000))
    (#\m . ,(* 60 1000 1000))
    (#\s . ,(* 1000 1000)))
  "Table mapping units (as characters) to microsecond lengths.")

(defun lock-length-string-to-usecs (str)
  "Convert the lock length string STR to microseconds (usec). Return nil if the
string means infinite length."
  (unless (equal str "infinity")
    (loop with sum = 0
          for i below (length str)
          for c = (aref str i)
          unless (eql c #\Space)
            do (multiple-value-bind (num chars)
                   (parse-integer str :start i :junk-allowed t)
                 (unless num
                   (error "Invalid time interval!"))
                 (setq i chars)
                 (let ((scale (assoc (if (< i (length str))
                                         (aref str i)
                                         #\s)
                                     *lock-length-string-units*)))
                   (unless scale
                     (error "Invalid time interval!"))
                   (incf sum (* num (cdr scale))))
                 ;; (incf i) implied
                 )
          finally (return sum))))

(defun list-locks-from-systemctl-show-output (stream)
  "List all running locks in STREAM, which contains the output from systemctl's
show command."
  (let ((cur-params (cons nil nil))
        (cur-params-count 0)
        output)
    (loop
      for line = (read-line stream nil)
      while line
      do (if (zerop (length line))
             (progn
               (when (= cur-params-count 2)
                 (push (make-instance 'running-lock
                                      :start-time (cdr cur-params)
                                      :length (car cur-params))
                       output))
               (setq cur-params-count 0))
             (destructuring-bind (key value)
                 (split-key-value-line line)
               (cond
                 ((equal key "Id")
                  (ignore-errors
                   (setf (car cur-params)
                         (lock-length-string-to-usecs
                          (extract-lock-length-string-from-service-name value)))
                   (incf cur-params-count)))
                 ((equal key "ExecMainStartTimestampMonotonic")
                  (setf (cdr cur-params) (parse-integer value))
                  (incf cur-params-count))))))
    (when (= cur-params-count 2)
      (push (make-instance 'running-lock
                           :start-time (cdr cur-params)
                           :length (car cur-params))
            output))
    output))

(defun list-running-locks ()
  "Return a list of running locks."
  (with-input-from-string
      (stream (uiop:run-program '("systemctl" "--user" "--no-pager" "--full"
                                  "--state=activating,active" "show"
                                  "manual-inhibit-sleep@*.service")
                                :output :string
                                :error-output :interactive
                                :input nil))
    (list-locks-from-systemctl-show-output stream)))

(defun sort-running-locks (locks &optional (start-usecs (monotonic-microseconds)))
  "Sort a list of running locks with one's ending sooner sorting after."
  (sort locks (lambda (lock1 lock2)
                (let ((usec1 (lock-microseconds-left
                              lock1 :from start-usecs))
                      (usec2 (lock-microseconds-left
                              lock2 :from start-usecs)))
                  (or (not usec1)
                      (and usec2 (> usec1 usec2)))))))

(defun toplevel ()
  "Main program entry point."
  (loop with start-usecs = (monotonic-microseconds)
        for lock in (sort-running-locks (list-running-locks) start-usecs)
        for rem-usec = (lock-microseconds-left lock :from start-usecs)
        when (not rem-usec)
          do (format t "infinity infinity~%")
        else when (plusp rem-usec)
               do (format t "~A ~A~%"
                          (format-seconds
                           (floor (/ (running-lock-length lock) 1000 1000)))
                          (floor (/ rem-usec 1000 1000)))))