<commit_before>(in-package #:orca)

(defmodule env env-module ("env" "take" "share" "steal" "release")
  (environments :accessor environments-of :initform nil)
  (leases :accessor leases-of :initform nil)
  (statuses :accessor statuses-of :initform nil))

(defmethod initialize-module ((module env-module) config)
  (load-env-data module))

(defun save-env-data (module)
  (with-open-file (ouf (orca-path "data/pss-envs.lisp")
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (write-line ";; Environments" ouf)
    (write (environments-of module) :stream ouf)
    (terpri ouf)
    (write-line ";; Leases" ouf)
    (write (leases-of module) :stream ouf)
    (terpri ouf)
    (write-line ";; Statuses" ouf)
    (write (statuses-of module) :stream ouf)
    (terpri ouf)))

(defun load-env-data (module)
  (with-open-file (inf (orca-path "data/pss-envs.lisp") :direction :input)
    (setf (environments-of module) (read inf nil nil))
    (setf (leases-of module) (read inf nil nil))
    (setf (statuses-of module) (read inf nil nil))))

(defun expire-env-leases (module)
  (let ((now (get-universal-time)))
    (setf (leases-of module) (delete-if (lambda (lease)
                                    (<= (fourth lease) now))
                                  (leases-of module)))))

(defun describe-time-left (span)
  (cond
    ((> span 86400)
     (format nil "~ad" (floor span 86400)))
    ((> span 3600)
     (format nil "~ah" (floor span 3600)))
    ((> span 60)
     (format nil "~am" (floor span 60)))
    (t
     (format nil "~as" span))))

(defun parse-expire-time (str)
  (multiple-value-bind (match regs)
      (cl-ppcre:scan-to-strings "^(\\d+)([dhms]?)$" str)
    (when match
      (let ((num (parse-integer (aref regs 0))))
        (+ (get-universal-time)
           (if (zerop (length (aref regs 1)))
               (* num 60)
               (ecase (char (aref regs 1) 0)
                 (#\d (* num 86400))
                 (#\h (* num 3600))
                 (#\m (* num 60))
                 (#\s num))))))))

(defun query-leases (module env-name leases)
  (let ((matching (remove env-name leases :test-not #'string-equal :key #'cadr))
        (status (cdr (assoc env-name (statuses-of module) :test #'string-equal))))
    (if matching
        (with-output-to-string (str)
          (format str "~a~@[(~a)~] used by: " env-name status)
          (loop
             with end = (last matching)
             for match-el on matching
             for match = (car match-el)
             do
             (format str "~a (~@[~a/~]~a)" (first match)
                     (third match)
                     (describe-time-left (- (fourth match) (get-universal-time))))
             (unless (eq match-el end)
               (format str ", "))))
        (format nil "~a~@[(~a)~] is currently free" env-name status))))

(defun remove-all-env-leases (module env-name)
  (setf (leases-of module) (remove env-name (leases-of module) :test #'string-equal :key #'second)))

(defun remove-env-lease (module env-name nick)
  (setf (leases-of module) (remove-if (lambda (lease)
                                  (and (string-equal (second lease) env-name)
                                       (string-equal (first lease) nick)))
                                (leases-of module))))

(defun create-lease (module env-name nick time-str activity)
  (let ((expire-time (parse-expire-time time-str)))
    (cond
      ((not (member env-name (environments-of module) :test #'string-equal))
       (format nil "Can't find environment ~a" env-name))
      ((null expire-time)
       (format nil "Sorry, didn't understand ~a as an amount of time" time-str))
      (t
       (remove-env-lease module env-name nick)
       (push (list nick env-name activity expire-time) (leases-of module))
       (save-env-data module)
       (format nil "~a taken by ~a for ~a"
               env-name
               nick
               (describe-time-left expire-time))))))

(defun env-has-lease-p (module env-name)
  (find env-name (leases-of module)
        :key #'second
        :test #'string-equal))

(defun release-lease (module env-name nick)
  (cond
    ((not (member env-name (environments-of module) :test #'string-equal))
     (format nil "Can't find environment ~a" env-name))
    (t
     (remove-env-lease module env-name nick)
     (save-env-data module)
     (format nil "~a released by ~a" env-name nick))))

(defun set-env-status (module env-name status)<commit_msg>Improve time display on leasing<commit_after>(in-package #:orca)

(defmodule env env-module ("env" "take" "share" "steal" "release")
  (environments :accessor environments-of :initform nil)
  (leases :accessor leases-of :initform nil)
  (statuses :accessor statuses-of :initform nil))

(defmethod initialize-module ((module env-module) config)
  (load-env-data module))

(defun save-env-data (module)
  (with-open-file (ouf (orca-path "data/pss-envs.lisp")
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (write-line ";; Environments" ouf)
    (write (environments-of module) :stream ouf)
    (terpri ouf)
    (write-line ";; Leases" ouf)
    (write (leases-of module) :stream ouf)
    (terpri ouf)
    (write-line ";; Statuses" ouf)
    (write (statuses-of module) :stream ouf)
    (terpri ouf)))

(defun load-env-data (module)
  (with-open-file (inf (orca-path "data/pss-envs.lisp") :direction :input)
    (setf (environments-of module) (read inf nil nil))
    (setf (leases-of module) (read inf nil nil))
    (setf (statuses-of module) (read inf nil nil))))

(defun expire-env-leases (module)
  (let ((now (get-universal-time)))
    (setf (leases-of module) (delete-if (lambda (lease)
                                    (<= (fourth lease) now))
                                  (leases-of module)))))

(defun describe-time-left (span)
  (cond
    ((> span 86400)
     (format nil "~ad" (round span 86400)))
    ((> span 3600)
     (format nil "~ah" (round span 3600)))
    ((> span 60)
     (format nil "~am" (round span 60)))
    (t
     (format nil "~as" span))))

(defun parse-expire-time (str)
  (multiple-value-bind (match regs)
      (cl-ppcre:scan-to-strings "^(\\d+)([dhms]?)$" str)
    (when match
      (let ((num (parse-integer (aref regs 0))))
        (+ (get-universal-time)
           (if (zerop (length (aref regs 1)))
               (* num 60)
               (ecase (char (aref regs 1) 0)
                 (#\d (* num 86400))
                 (#\h (* num 3600))
                 (#\m (* num 60))
                 (#\s num))))))))

(defun query-leases (module env-name leases)
  (let ((matching (remove env-name leases :test-not #'string-equal :key #'cadr))
        (status (cdr (assoc env-name (statuses-of module) :test #'string-equal))))
    (if matching
        (with-output-to-string (str)
          (format str "~a~@[(~a)~] used by: " env-name status)
          (loop
             with end = (last matching)
             for match-el on matching
             for match = (car match-el)
             do
             (format str "~a (~@[~a/~]~a)" (first match)
                     (third match)
                     (describe-time-left (- (fourth match) (get-universal-time))))
             (unless (eq match-el end)
               (format str ", "))))
        (format nil "~a~@[(~a)~] is currently free" env-name status))))

(defun remove-all-env-leases (module env-name)
  (setf (leases-of module) (remove env-name (leases-of module) :test #'string-equal :key #'second)))

(defun remove-env-lease (module env-name nick)
  (setf (leases-of module) (remove-if (lambda (lease)
                                  (and (string-equal (second lease) env-name)
                                       (string-equal (first lease) nick)))
                                (leases-of module))))

(defun create-lease (module env-name nick time-str activity)
  (let ((expire-time (parse-expire-time time-str)))
    (cond
      ((not (member env-name (environments-of module) :test #'string-equal))
       (format nil "Can't find environment ~a" env-name))
      ((null expire-time)
       (format nil "Sorry, didn't understand ~a as an amount of time" time-str))
      (t
       (remove-env-lease module env-name nick)
       (push (list nick env-name activity expire-time) (leases-of module))
       (save-env-data module)
       (format nil "~a taken by ~a for ~a"
               env-name
               nick
               (describe-time-left (- expire-time (get-universal-time))))))))

(defun env-has-lease-p (module env-name)
  (find env-name (leases-of module)
        :key #'second
        :test #'string-equal))

(defun release-lease (module env-name nick)
  (cond
    ((not (member env-name (environments-of module) :test #'string-equal))
     (format nil "Can't find environment ~a" env-name))
    (t
     (remove-env-lease module env-name nick)
     (save-env-data module)
     (format nil "~a released by ~a" env-name nick))))

(defun set-env-status (module env-name status)
{'fraction_non_alphanumeric': 0.15395557500820659, 'fraction_numerical': 0.008534850640113799, 'mean_word_length': 2.167013167013167, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1399373', 'n_tokens_mistral': 3122, 'n_tokens_neox': 2958, 'n_words': 858}