;;;; timesheet.lisp

(in-package #:timesheet)

(ubiquitous:restore 'timesheet)

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

(defvar *default-time-sheet-file*)
(defvar *rate*)

(defmethod duration ((obj partial-entry))
  (warn "incomplete entry detected for ~a" (client obj))
  (local-time-duration:duration))

(defun make-complete-entry (date client memo duration)
  (make-instance 'complete-entry
                 :date date
                 :client client
                 :memo memo
                 :duration duration))

(defun make-partial-entry (date client memo start-times)
  (make-instance 'partial-entry
                 :date date
                 :client client
                 :memo memo
                 :start-times start-times))

(defun parse-file (&optional (file *default-time-sheet-file*))
  (with-open-file (s file :direction :input)
    (let ((dest (make-string (file-length s))))
      (read-sequence dest s)
      (multiple-value-bind (parsed leftovers) (smug:parse (timesheet.parser::.date-records) dest)
        (unless (string= leftovers "")
          (cerror "Continue?" 'parsing-error :leftovers leftovers))
        parsed))))

(defun unroll-date (date-obj)
  (with-slots (year month day) date-obj
    (list day month year)))

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

(defun calculate-ranges (ranges year month day)
  (flet ((time-mod-unit-keyword (time-mod)
           (make-keyword
             (string-upcase
               (if (string= (slot-value time-mod 'unit) "mins")
                 "minute"
                 "hour")))))
    (loop with complete = nil
          with partial = nil
          for (start-obj end-obj mod) in ranges
          for start = (combine-date-time start-obj year month day)
          for end = (when end-obj (combine-date-time end-obj year month day))
          for time-mod = (when mod
                           (let ((unit (time-mod-unit-keyword mod))
                                 (amount (slot-value mod 'timesheet.parser:amount)))
                             (funcall #'local-time-duration:duration unit amount)))
          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-rounded-ranges (ranges)
  (flet ((calc-duration-in-15mins (duration)
           (let ((duration-in-minutes (local-time-duration:duration-as duration :minute)))
             (coerce (/ (round duration-in-minutes 15) 4)
                     'float))))
    (calc-duration-in-15mins
      (reduce #'local-time-duration:duration+ ranges
        :initial-value (local-time-duration:duration)))))

(defun get-entry-ranges (entry)
  (let ((date (slot-value entry 'date)))
    (with-slots (year month day) date
      (loop for record in (slot-value entry 'records)
            append (with-slots (client memo ranges) record
                     (multiple-value-bind (complete partial) (calculate-ranges ranges day month year)
                       (list*
                         (make-complete-entry date client memo (calculate-rounded-ranges complete))
                         (when partial
                           (list
                             (make-partial-entry date client memo partial))))))))))

(defun get-log (&optional (file *default-time-sheet-file*))
  (block nil
     (let* ((entries (parse-file file)))
       (loop for entry in entries
             for ranges = (get-entry-ranges entry)
             append ranges))))

(defparameter +pprint-log-option-spec+
  '((("client" #\c) :type boolean :optional t :documentation "Sort by client")
    (("reverse" #\r) :type boolean :optional t :documentation "Reverse sort")
    (("status" #\s) :type boolean :optional t
                    :documentation "Print a summary of the hours worked and the prices")
    (("help" #\h) :type boolean :optional t :documentation "show help")))

(defparameter *version* "0:1")
(defun show-version ()
  (format t "timesheet, common-lisp version ~a~%" *version*))

(defun show-help ()
  (show-version)
  (command-line-arguments:show-option-help +pprint-log-option-spec+ :sort-names t))

(defun sort-by-date (results)
  (stable-sort results #'local-time:timestamp<
               :key (alambda (apply #'local-time:encode-timestamp
                                    (append '(0 0 0 0)
                                            (unroll-date (date it)))))))

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

(defgeneric print-entries (entries)
  (:method ((entries list))
   (mapcar #'print-entries entries))
  (:method ((entry partial-entry))
   (format t "~&~4<~>~a, ~a:~%~{~12<~>one starting at ~a~%~}"
           (client entry)
           (memo entry)
           (mapcar
             (alambda (local-time:format-timestring
                        nil it
                        :format '(:year #\/ (:month 2) #\/ (:day 2) #\Space
                                  (:hour 2) #\: (:min 2) #\: (:sec 2))))
             (start-times entry))))
  (:method ((it complete-entry))
   (format t "~&~4a ~10<~:(~a~)~> ~7,2F hrs ~a~%"
           (date it) (client it) (duration it) (memo it))))

(defgeneric record-client (calc client hours)
  (:method ((calc status-calculator) client hours)
    (let ((client (make-keyword (string-upcase client))))
      (incf (gethash client (clients calc) 0)
            hours))))

(defgeneric update (calculator entry)
  (:method ((calculator status-calculator) entry)
   (incf (total-hours calculator) (duration entry)))
  (:method ((calculator status-line) entry)
   (incf (duration calculator) (duration entry))))

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

(defun calculate-results (results &optional (rate *rate*))
  (let ((status-calculator
          (make-instance 'status-calculator
                         :rate rate
                         :client-totals (make-hash-table :test 'equalp))))
    (prog1 status-calculator
      (loop for entry in results
            do (update-clients (client-totals status-calculator) entry)
            do (update status-calculator entry)))))

(defgeneric total-line (calc rate)
  (:method ((calc status-calculator) rate)
   (with-accessors ((total-hours total-hours)) calc
     (format nil "~26<Total~>:~7,2F hours @ ~7,2F $/hr = $~7,2F"
             total-hours rate (* rate total-hours)))))

(defgeneric calculate-cost (calc time)
  (:method ((calc status-calculator) (status-line status-line))
   (* (rate calc) (duration status-line))))

(defun print-status (results)
  (let* ((status-calculator (calculate-results results)))
    (flet ((print-status-line (status-line)
             (format t "~&~:(~26<~a~>~):~7,2F hours @ ~7,2F $/hr = $~7,2F~%"
                     (client status-line)
                     (duration status-line)
                     (rate status-calculator)
                     (calculate-cost status-calculator status-line))))
      (format t "~&~120,1,0,'-<~>~%")
      (loop with client-totals = (client-totals status-calculator)
            for  client in (sort (hash-table-keys client-totals) #'string-lessp)
            for  status-line = (gethash client client-totals)
            do (print-status-line status-line))
      (format t (total-line status-calculator *rate*)))))

(defun pprint-results (results incompletes status)
  (print-entries results)

  (when incompletes
    (format t "~&~120,1,0,'-<~>~%Partial Entries:~%")
    (print-entries incompletes))

  (when status
    (print-status results)))

(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

(defun pprint-log (args &key client reverse status help)
  (when help
    (show-help)
    (return-from pprint-log))

  (flet ((sort-results (results &optional (client client))
           (setf results (sort-by-date results))
           (when client
             (setf results (stable-sort results #'string-lessp :key #'client)))
           (when reverse
             (setf results (nreverse results)))
           results))

    (let ((*default-time-sheet-file* (or (car args) *default-time-sheet-file*))
          (*print-pretty* t))
      (destructuring-bind (complete-ranges incomplete-ranges) (group-by-class (get-log *default-time-sheet-file*))
        (let ((complete-results (sort-results complete-ranges))
              (incomplete-results (sort-results incomplete-ranges t)))
          (pprint-results complete-results incomplete-results status))))))

(defun pprint-log-main (argv)
  (setf *rate* (ubiquitous:defaulted-value 0 :rate)
        *default-time-sheet-file* (ubiquitous:defaulted-value #p"~/time.md" :timesheet :file))
  (command-line-arguments:handle-command-line
    +pprint-log-option-spec+
    'pprint-log
    :command-line (cdr argv)
    :name "timesheet"
    :rest-arity t))