git.fiddlerwoaroof.com
Raw Blame History
(in-package #:tempores)

(defclass status-calculator ()
  ((rate :initarg :rate :accessor rate)
   (total-hours :initform 0 :initarg :total-hours :accessor total-hours)
   (client-totals :initarg :client-totals :accessor client-totals :initform (make-hash-table :test 'equalp))))

(defclass report ()
  ((status-calculator :initarg :status-calculator :accessor status-calculator)
   (status-lines :initform nil :accessor :status-lines)
   (entries :initform nil :accessor :entries)))

(defun make-status-calculator (rate)
  (make-instance 'status-calculator :rate rate))

(defclass status-line ()
  ((client :initarg :client :accessor client)
   (duration :initarg :duration :accessor duration :initform 0)))

(defclass parsed-entry ()
  ((date :initarg :date :accessor date)
   (client :initarg :client :accessor client)
   (memo :initarg :memo :accessor memo)))

(defclass complete-entry (parsed-entry)
  ((duration :initarg :duration :accessor duration)))

(defclass partial-entry (parsed-entry)
  ((start-times :initarg :start-times :initform nil :accessor start-times)))

(define-condition autocorrect-warning (warning)
  ((old-value :initarg :old-value :accessor old-value)
   (new-value :initarg :new-value :accessor new-value))
  (:report (lambda (condition stream)
             (with-slots (old-value new-value) condition
               (format stream "Automatic correction made: ~s -> ~s" old-value new-value)))))

(define-condition incomplete-entry-warning (warning) ()
  (:report (lambda (condition stream)
             (declare (ignore condition))
             (format stream "Incomplete Entry Found"))))

(define-condition parsing-error ()
  ((leftovers :initarg :leftovers :accessor leftovers))
  (:report (lambda (condition stream)
               (format stream "Parse error: ~20s leftover" (leftovers condition)))))

(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))))

#|
(define-message print-partial-line (client memo duration starts)
  )
|# 

(defgeneric print-entries (entries)
  (:method ((entries list))
   (mapcar #'print-entries entries))
  (:method ((entry partial-entry))
   (format t "~&~4<~>~a, ~a (currently ~3,2f hours):~%~{~12<~>one starting at ~a~%~}"
           (client entry)
           (memo entry)
           (handler-bind ((incomplete-entry-warning (lambda (c) c (invoke-restart 'duration-to-now))))
             (calculate-duration-in-15mins (duration entry)))
           (mapcar
             (alambda (list (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))))


(defmethod duration ((obj partial-entry))
  (restart-case
    (progn (warn 'incomplete-entry-warning)
           (local-time-duration:duration)) 
    (zero-duration () (local-time-duration:duration))
    (duration-to-now ()
      (let ((now (local-time:now)))
        (local-time-duration:timestamp-difference
          now
          (extremum (start-times obj) #'local-time-duration:duration>
                    :key (alambda (local-time-duration:timestamp-difference now it))))))))

(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))