(in-package #:tempores.parser)

(eval-when (:compile-toplevel :load-toplevel :execute)
  ;; make sure these classes am ready to go!
  (defclass day-entry ()
    ((date :initarg :date)
     (records :initarg :records)))

  (defclass time-record ()
    ((client :initarg :client)
     (ranges :initarg :ranges)
     (memo :initarg :memo)))

  (defclass time-obj ()
    ((hour :initarg :hour)
     (minute :initarg :minute)
     (second :initarg :second)))

  (defclass date-obj ()
    ((day-of-week :initarg :day-of-week)
     (year :initarg :year)
     (month :initarg :month)
     (day :initarg :day)))

  (defclass time-mod ()
    ((amount :initarg :amount)
     (unit :initarg :unit :type (member '(:hour :minute))))))

(defgeneric unparse (token &optional stream)
  (:method ((token time-mod) &optional stream)
   (with-slots (amount unit) token
     (format stream "~@d~a" amount unit)))
  (:method ((token date-obj)  &optional stream)
   (with-slots (day-of-week year month day) token
     (let ((day-of-week (format nil "~aday"
                                (string-case (string-downcase day-of-week)
                                  ("tue" (setf day-of-week "Tues"))
                                  ("wed" (setf day-of-week "Wednes"))
                                  ("thu" (setf day-of-week "Thurs"))
                                  ("sat" (setf day-of-week "Satur"))
                                  (t (string-capitalize day-of-week))))))
       (format stream "~a ~2,'0d-~2,'0d-~2,'0d" day-of-week year month day))))
  (:method ((token time-obj) &optional stream)
   (with-slots (hour minute second) token
     (format stream "~2,'0d:~2,'0d:~2,'0d" hour minute second)))
  (:method ((token time-record) &optional stream)
   (with-slots (client ranges memo) token
     (format stream "~&   start@~{~a~^,~}~%   ~a: ~a~%"
             (loop for (start . rest) in ranges
                   for end = (car rest)
                   for mod = (cadr rest)
                   collect (format nil "~a--~a~a"
                                   (unparse start)
                                   (if end (unparse end) "")
                                   (if mod (unparse mod) "")))
             client memo)))
  (:method ((token day-entry) &optional stream)
   (with-slots (date records) token
     (format stream "~&-- ~a~&~{~a~}~%"
             (unparse date)
             (mapcar #'unparse records)))))

(make-simple-equality day-entry :test ==)
(make-simple-equality time-record :test ==)
(make-simple-equality time-obj :test eql)
(make-equality date-obj
  (day-of-week ==)
  (year) (month) (day))
(make-simple-equality time-mod :test eql)

(defun make-day-entry (date records)
  (make-instance 'day-entry :date date :records records))

(defun make-time-record (ranges memo)
  (make-instance 'time-record :client (car memo) :ranges ranges :memo (cadr memo)))

(defun make-time-mod (amnt unt)
  (setf unt (string-downcase unt))
  (make-instance 'time-mod
                 :amount amnt
                 :unit (string-ecase unt
                         ("min" :minute)
                         ("mins" :minute)
                         ("minutes" :minute)
                         ("minute" :minute)
                         ("hr" :hour)
                         ("hrs" :hour)
                         ("hour" :hour)
                         ("hours" :hour))))

(define-condition parsing-error (parse-error)
  ((failed-chunk :initarg :failed-chunk :reader failed-chunk)))

(define-condition invalid-whitespace (parsing-error) ()
  (:report (lambda (condition stream)
             (format stream "~s is invalid whitespace"
                     (map 'list #'char-code (failed-chunk condition))))))

(define-condition invalid-day-of-week (parsing-error)
  ((day-of-week :initarg :day-of-week :reader day-of-week))
  (:report (lambda (condition stream)
             (format stream "~s is not a valid day of the week"
                     (day-of-week condition)))))

(defun make-date-obj (day-of-week year month day)
  (let ((day-of-week (subseq day-of-week 0 3)))
    (if (member day-of-week
                '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")
                :test #'string-equal)
      (make-instance 'date-obj :day-of-week day-of-week :year year :month month :day day)
      (error 'invalid-day-of-week :day-of-week day-of-week))))

(defun make-time-obj (hour minute &optional second)
  (make-instance 'time-obj :hour hour :minute minute :second second))

(defmethod-and-inverse == ((date-obj date-obj) (list list))
  (with-slots (day-of-week year month day) date-obj
    (every #'== (list day-of-week year month day) list)))

(defmethod-and-inverse == ((time-obj time-obj) (list list))
  (with-slots (hour minute second) time-obj
    (every #'== (list hour minute second) list)))

(define-printer (date-obj s)
  ((with-slots (day-of-week year month day) date-obj
     (format s "~a, ~2,'0d/~2,'0d/~2,'0d"
             (subseq (string-capitalize day-of-week) 0 3)
             year month day)))
  ((with-slots (day-of-week year month day) date-obj
    (format s "~a, ~2,'0d/~2,'0d/~2,'0d"
            (subseq (string-capitalize day-of-week) 0 3)
            year month day))))

(define-printer (time-obj s)
  ((with-slots (hour minute second) time-obj
    (format s "~2,'0d:~2,'0d:~2,'0d"  hour minute second)))
  ((with-slots (hour minute second) time-obj
    (format s "~2,'0d:~2,'0d:~2,'0d"  hour minute second))))

(define-printer (day-entry s)
  ((with-slots (date records) day-entry
    (format s "~d records for ~s" (length records) date)))
  ((with-slots (date records) day-entry
    (format s "~d records for ~s" (length records) date))))

(define-printer (time-record s)
  ((with-slots (client) time-record
    (format s "For ~s" client)))
  ((with-slots (client) time-record
    (format s "For ~s" client))))

(define-printer (time-mod s)
  ((with-slots (amount unit) time-mod
    (format s "~s ~s" amount unit)))
  ((with-slots (amount unit) time-mod
    (format s "~s ~s" amount unit))))