;; tempores.lisp

(in-package #:tempores)

;;; "tempores" goes here. Hacks and glory await!

(defmacro maybe-list (test &optional val)
  "If both arguments passed, when test is true, return a list containing val
   or, when test is false, return nil.  If one argument passed, when test names
   something that is not a list, return a list containing it, otherwise
   return nil."
  (once-only (test)
    (let ((test (if val test `(not (listp ,test))))
          (val (if val val test)))
      `(when ,test
         (list ,val)))))

(defun combine-date-time (time-obj day month year)
  (declare (optimize (debug 3)))
  (with-slots (second minute hour) time-obj
    (local-time:encode-timestamp 0 second minute hour
                                 day month year)))

(defun calculate-ranges (ranges date)
  (declare (optimize (debug 3)))
  (labels ((time-mod-unit-keyword (time-mod)
             (slot-value time-mod 'unit))
           (make-mod (mod)
             (when mod
               (let ((unit (time-mod-unit-keyword mod))
                     (amount (slot-value mod 'tempores.parser:amount)))
                 (funcall #'local-time-duration:duration unit amount)))))
    (with-slots (year month day) date
      (loop with complete = nil
        with partial = nil
        for (start-obj end-obj mod) in ranges
        for start = (combine-date-time start-obj day month year)
        for end = (when end-obj (combine-date-time end-obj day month year))
        for time-mod = (when mod (make-mod mod))
        if end do (push (local-time-duration:timestamp-difference end start) complete)
        else do (push start partial)
        when time-mod do (push time-mod complete)
        finally (return (values complete partial))))))

(defun calculate-duration-in-15mins (duration)
  (let ((duration-in-minutes (local-time-duration:duration-as duration :minute)))
    (coerce (/ (round duration-in-minutes 15) 4)
            'float)))

(defun calculate-rounded-ranges (ranges)
  (let-each (:be *)
    (local-time-duration:duration)
    (reduce #'local-time-duration:duration+ ranges :initial-value *)
    (calculate-duration-in-15mins *)))

(defclass log-entry ()
  ((complete :initarg :complete)
   (incomplete :initarg :incomplete)))

(defun get-entry-ranges (entry)
  (flet ((make-entry (record)
           (let ((date (slot-value entry 'date)))
             (with-slots (client memo ranges) record
               (multiple-value-bind (complete partial) (calculate-ranges ranges date)
                 (list*
                   (make-complete-entry date client memo (calculate-rounded-ranges complete))
                   (maybe-list partial
                               (make-partial-entry date client memo partial))))))))
    (let-each (:be *)
      (slot-value entry 'records)
      (mapcan #'make-entry *))))

(defun get-log (&optional (file *default-time-sheet-file*) ignore-whitespace)
  (let* ((entries (tempores.cli::parse-file file ignore-whitespace)))
    (mapcan #'get-entry-ranges entries)))

(defun group-by-client (incompletes)
  (let ((results (make-hash-table :test 'equalp)))
    (loop for incomplete in incompletes
          for client = (client incomplete)
          do (push incomplete (gethash client results)))
    (hash-table-alist results)))

(defun update-clients (status-calculator entry)
  (flet ((ensure-client (client)
           (ensure-gethash client
                           (client-totals status-calculator)
                           (make-instance 'status-line :client client))))
    (with-accessors ((client client)) entry
      (let ((client-hash-table (ensure-client client)))
        (update client-hash-table entry)))))

(defun calculate-results (results &optional (rate *rate*))
  (let-first (:be status-calculator) (make-status-calculator rate)
    (dolist (result results)
      (update-clients status-calculator result)
      (update status-calculator result))))

(define-message status-line-format (client duration rate cost)
  (:own-line ()
   (:titlecase () (:rjust (26) :str))
   ": " (:float 7 2) " hours @ " (:float 7 2) " $/hr = $" (:float 7 2)))

(defun print-status (results)
  (let* ((status-calculator (calculate-results results))
         (client-totals (client-totals status-calculator)))
    (labels ((print-status-line (status-line)
               (with-slots (client duration) status-line
                 (status-line-format t client duration
                                     (rate status-calculator)
                                     (calculate-cost status-calculator status-line))))
             (print-separator ()
               (format t "~&~120,1,0,'-<~>~%")))
      (let-each (:be *)
        (print-separator)
        (hash-table-keys client-totals)
        (sort * #'string-lessp)
        (dolist (client *)
          (print-status-line (gethash client client-totals)))
        (format t (total-line status-calculator *rate*))))))


(defun group-by-class (list &optional accum1 accum2)
  (tagbody ; Let's do some TCO ...
    start
    (if (null list)
      (return-from group-by-class (list accum1 accum2))
      (destructuring-bind (head . tail) list
        (etypecase head
          (complete-entry (setf accum1 (cons head accum1))) ; Here we set the accumulators
          (partial-entry (setf accum2 (cons head accum2)))) ;  to the appropriate values.
        (setf list tail) ; Here we step towards the terminating condition
        (go start))))) ; Recurse

(defmacro with-tempores-configuration (() &body body)
  `(progn
     (ubiquitous:restore 'tempores)
     (let ((*rate* (ubiquitous:defaulted-value 0 :rate))
           (*default-time-sheet-file*
             (ubiquitous:defaulted-value #p"~/bucket/time.md" :tempores :file)))
       ,@body)))