Yu-Gi-Oh! Deck Building and Card Inventory Management web interface written in Common Lisp, utilizing HTMX.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

90 lines
3.5KB

  1. ;; I noticed I've been doing a lot of work with time. This is time
  2. ;; helpers.
  3. (in-package #:cl-deck-builder2.toolkit.time)
  4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. (defun time-format (when &optional (format local-time:+rfc3339-format+))
  6. (local-time:format-timestring nil when :format format))
  7. (defun time-format/date-only (when)
  8. (time-format when local-time:+rfc3339-format/date-only+))
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. (defun day- (when &optional (amount 1))
  11. "Subtract AMOUNT days from WHEN."
  12. (local-time:timestamp- when amount :day))
  13. (defun day+ (when &optional (amount 1))
  14. "Add AMOUNT days to WHEN."
  15. (local-time:timestamp+ when amount :day))
  16. (defun month- (when &optional (amount 1))
  17. "Subtract AMOUNT months from WHEN."
  18. (local-time:timestamp-
  19. (local-time:timestamp- when amount :month)
  20. local-time:+seconds-per-day+ :sec))
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22. (defun time-now ()
  23. "Today's date, passed through FORMAT-DMY."
  24. (local-time:now))
  25. (defun time-yesterday ()
  26. "Yesterday's date, passed through FORMAT-DMY."
  27. (day- (time-now)))
  28. ;; TODO Why am I using this?
  29. (defun time-first-of-month ()
  30. "The first day of this month."
  31. (local-time:timestamp-minimize-part
  32. (time-now) :day))
  33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34. (defun n-month-list (&key (when (time-now)) (start 1) (n 6))
  35. "Produce a LIST of the last N months, using WHEN as the reference point.
  36. The values iterate numerically from START, that is, the result will be length N - START.
  37. The date will be on the first of each month, in chronological order."
  38. (mapcar (lambda (n)
  39. (month- when n))
  40. (loop for i from start upto n collect i)))
  41. (defun n-day-list (&key (when (time-now)) (start 0) (n 5))
  42. "Produce a LIST of the last N days, using WHEN as a reference point.
  43. The values will iterate numerically from START, that is, the result will be length N - START.
  44. The exact times will not be modified. The results will be in chronological order."
  45. (mapcar (lambda (n)
  46. (day- when n))
  47. (loop for i from start upto n collect i)))
  48. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49. (defun time-friday (&key (when (time-now)))
  50. (local-time:adjust-timestamp
  51. when
  52. (offset :day-of-week :friday)))
  53. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54. (defun format-status-report (&key (stream *standard-output*) (when (time-friday)))
  55. (let ((date-str (time-format/date-only when))
  56. (day-map (reverse
  57. (mapcar #'time-format/date-only (n-day-list :when when :n 4)))))
  58. (format stream
  59. "#+TITLE: Status Report: Week of ~A~%~%* Status Report: ~
  60. Week of ~A~%~%Total hours: 40 h.~%~%~{** ~A~%~%Hours: 0800A-1600P (8h)~%~%~}"
  61. date-str date-str day-map)))
  62. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63. (defparameter *status-report-base-dir*
  64. (probe-file #P"~/code/cl-deck-builder2/doc/status-report/"))
  65. (defun generate-status-report (&key (when (time-friday)))
  66. (let ((filespec (merge-pathnames
  67. (format nil "~a.org" (time-format/date-only when))
  68. *status-report-base-dir*)))
  69. (with-open-file (f filespec
  70. :direction :output
  71. :if-exists :error
  72. :if-does-not-exist :create)
  73. (format-status-report :stream f :when when)
  74. (probe-file filespec))))