Yu-Gi-Oh! Deck Building and Card Inventory Management web interface written in Common Lisp, utilizing HTMX.
Nie możesz wybrać więcej, niż 25 tematów Tematy muszą się zaczynać od litery lub cyfry, mogą zawierać myślniki ('-') i mogą mieć do 35 znaków.

90 wiersze
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))))