(defpackage clash/parse-date
  (:documentation "Functions for parsing dates and date ranges.")
  (:use #:cl)
  (:export #:print-date-parsing-help
           #:date-parse-error
           #:date-parse-error-source
           #:date-parse-error-position
           #:dase-parse-error-message
           #:parse-date-time
           #:parse-date-range
           #:timestamp-in-ranges
           #:option-date-range
           #:option-date-range-ranges))

(in-package :clash/parse-date)

(defun print-date-parsing-help (stream)
  "Print information about date parsing to STREAM."
  (format stream "~
Dates can take one of the following forms (<THING> means THING is required,
[THING] means it is optional):
          \"now\"  - the current date and time
        \"today\"* - midnight on the current day
    \"yesterday\"* - midnight on the day before the current day
     \"<NUMBER>\"  - integer seconds since midnight on January 1 1970 (UCT)
  \"<M> <D> [Y]\"* - midnight on the Dth day of M (a month's name) of the Yth
                   year, or the current year if Y is omitted (any of the
                   whitespace between M, D, and Y can be replaced with a \"/\")
In the above table, any format which has a * next to it can optionally be
followed by a time in the format:
  \"<HOUR>:<MINUTE>[:SECOND] [AM|PM]\"
If SECOND is omitted, it is 0. If AM or PM are omitted, the time is assumed to
be in 24-format. If the time is omitted entirely, midnight on the given date is
assumed.

Date ranges consist of one or two dates, separated by \"..\". If just one date
is given without a separator, the pattern matches exactly that date (and
time). If two dates are given, the patten matches any time between the two dates
(inclusive of the bounds). If just a date of the form \"<START>..\" is given, it
means \"any time after START\". Likewise, any date of the form \"..<END>\" means
\"anytime before END\".

Dates are supplied to commands that support then via the -R or --date-range
flags. These flags can be given any number of times. Any item which matches at
least one range given will match (that is, the union of all given dates).~%"))

(define-condition date-parse-error (error)
  ((source :accessor date-parse-error-source
           :type string
           :initarg :source
           :documentation "The string that failed to parse.")
   (pos :accessor date-parse-error-position
        :type (or null integer)
        :initarg :position
        :initform nil
        :documentation "The position of the error, or nil.")
   (message :accessor date-parse-error-message
            :type string
            :initarg :message
            :documentation "A message describing the error."))
  (:report (lambda (condition stream)
             (format
              stream "Failed to parse date ~S~@[ at position ~A~]: ~A"
              (date-parse-error-source condition)
              (date-parse-error-position condition)
              (date-parse-error-message condition))))
  (:documentation "A condition representing a failure in parsing a date range."))

(defparameter *month-conversion-table*
  '((1 "january" "jan")
    (2 "february" "feb")
    (3 "march" "mar")
    (4 "april" "apr")
    (5 "may")
    (6 "june" "jun")
    (7 "july" "jly" "jul")
    (8 "august" "aug")
    (9 "september" "sep")
    (10 "october" "oct")
    (11 "november" "nov")
    (12 "december" "dec")))

(defun parse-month-string (str)
  (loop for (num . text) in *month-conversion-table*
        when (member str text :test 'equalp)
          do (return num)))

(defun add-time-registers (source stamp registers)
  (destructuring-bind (hour minute second am-pm) (last registers 4)
    (local-time:adjust-timestamp stamp
      (offset :sec (parse-integer (or second "0")))
      (offset :minute (parse-integer (or minute "0")))
      (offset :hour
              (if (not hour)
                  0
                  (cond
                    ((or (not am-pm) (equalp am-pm "am")) (parse-integer hour))
                    ((equalp am-pm "pm") (+ (parse-integer hour) 12))
                    (t (error 'date-parse-error
                              :source source
                              :message
                              (format nil "excpected \"AM\"/\"PM\", got: ~A"
                                      am-pm)))))))))

(defun current-year ()
  "Return the current year."
  (local-time:timestamp-year (local-time:now)))

(defun local-today ()
  "Return a timestamp representing the midnight today in local-time."
  (local-time:adjust-timestamp! (local-time:now)
    (set :hour 0)
    (set :minute 0)
    (set :sec 0)
    (set :nsec 0)))

(defparameter *date-parse-formats*
  (let ((time-regexp
          (format nil "(?:\\s|$)(?:\\s*([0-9]{1,2}):([0-9]{1,2})~
                       (?::([0-9]{1,2}))?(?:\\s*(AM|PM))?)?"))
        out)
    (flet ((def (regexp func)
             (push (cons (cl-ppcre:create-scanner
                          (format nil "~A~A" regexp time-regexp)
                          :extended-mode t :case-insensitive-mode t
                          :multi-line-mode t)
                         func)
                   out))
           (def-no-time (regexp func)
             (push (cons (cl-ppcre:create-scanner regexp
                                                  :extended-mode t :case-insensitive-mode t
                                                  :multi-line-mode t)
                         func)
                   out)))
      (def-no-time "[0-9]+"
          (lambda (source registers)
            (declare (ignore registers))
            (local-time:unix-to-timestamp (parse-integer source))))
      (def-no-time "now"
          (lambda (source registers)
            (declare (ignore source registers))
            (local-time:now)))
      (def "today"
          (lambda (source registers)
            (add-time-registers source
                                (local-today)
                                registers)))
      (def "yesterday"
          (lambda (source registers)
            (add-time-registers source
                                (local-time:adjust-timestamp! (local-today)
                                  (offset :day -1))
                                registers)))
      ;; 2025/10/23 3:00 pm
      (def "([0-9]+)(?:\\s+|/)([0-9]{1,2})(?:\\s+|/)([0-9]{1,2})"
          (lambda (source registers)
            (destructuring-bind (year month day &rest ignore) registers
              (declare (ignore ignore))
              (add-time-registers source
                                  (local-time:encode-timestamp
                                   0 0 0 0
                                   (parse-integer day)
                                   (parse-integer month)
                                   (parse-integer year))
                                  registers))))
      ;; Oct 10/23 3:00 PM
      (def "([A-Za-z]+)(?:\\s+|/)([0-9]{1,2})(?:(?:\\s+|/)([0-9]+))?"
          (lambda (source registers)
            (destructuring-bind (month-str day year &rest ignore)
                registers
              (declare (ignore ignore))
              (let ((month (parse-month-string month-str)))
                (unless month
                  (error 'date-parse-error
                         :source source
                         :message (format nil "unknown month: ~S" month-str)))
                (add-time-registers source
                                    (local-time:encode-timestamp
                                     0 0 0 0
                                     (parse-integer day)
                                     month
                                     (if year
                                         (parse-integer year)
                                         (current-year)))
                                    registers))))))))

(defun parse-date-time (string)
  "Parse date and time from STRING."
  (dolist (entry *date-parse-formats*)
    (destructuring-bind (scanner . func) entry
      (multiple-value-bind (start end reg-starts reg-ends)
          (cl-ppcre:scan scanner string)
        (when (and (eql start 0)
                   (eql end (length string)))
          (return-from parse-date-time
            (funcall func
                     string
                     (loop for s across reg-starts
                           for e across reg-ends
                           when (and s e)
                             collect (subseq string s e)
                           else
                             collect nil)))))))
  ;; we call return-from above, so this will only run if all know patterns fail
  ;; to match
  (error "Invalid date string: ~S" string))

(defun parse-date-range (string)
  "Parse a date range from STRING."
  (let ((sep (search ".." string)))
    (if (not sep)
        (parse-date-time string)
        (progn
          (let ((second-sep (search ".." string :start2 (1+ sep))))
            (when second-sep
              (error 'date-parse-error :source string
                                       :position second-sep
                                       :message "multiple \"..\" found")))
          (let* ((start (string-trim '(#\Tab #\Space #\Newline)
                                     (subseq string 0 sep)))
                 (end (string-trim '(#\Tab #\Space #\Newline)
                                   (subseq string (+ sep 2)))))
            (when (and (zerop (length start))
                       (zerop (length end)))
              (error "Invalid date range: ~S" string))
            (cons (when (plusp (length start))
                    (parse-date-time start))
                  (when (plusp (length end))
                    (parse-date-time end))))))))

(defun timestamp-in-ranges (stamp ranges)
  "Return non-nil if STAMP is in one of RANGES."
  (some (lambda (range)
          (destructuring-bind (start . end) range
            (when (and start end (local-time:timestamp> start end))
              (rotatef start end))
            (and (or (not start) (local-time:timestamp>= stamp start))
                 (or (not end) (local-time:timestamp<= stamp end)))))
        ranges))

(defclass option-multi-parsed (clingon:option)
  ((parser :accessor option-multi-parsed-parser
           :initarg :parser
           :type (function (string) t)
           :documentation "The function that parses the passed value.")
   (values :accessor option-multi-parsed-values
           :initform nil
           :type list
           :documentation "The list of parsed values passed by the user."))
  (:default-initargs :parameter "VALUE")
  (:documentation "An option type that parses each value passed by the user."))

(defmethod clingon:derive-option-value ((option option-multi-parsed) arg &key)
  (with-slots (parser values) option
    (push (funcall parser arg) values)))

(defmethod clingon:finalize-option ((option option-multi-parsed) &key)
  (with-slots (values) option
    (setq values (nreverse values))))

(defmethod clingon:make-option ((kind (eql :multi-parsed)) &rest args)
  (apply #'make-instance 'option-multi-parsed args))

(defclass option-date-range (option-multi-parsed)
  ()
  (:default-initargs :parameter "RANGE" :parser #'parse-date-range))

(defmethod clingon:make-option ((kind (eql :date-range)) &rest args)
  (apply #'make-instance 'option-date-range args))