git.fiddlerwoaroof.com
main-classes.lisp
d2878c38
 (in-package #:tempores)
b411883d
 
 (defclass status-calculator ()
   ((rate :initarg :rate :accessor rate)
b9ab1c24
    (total-hours :initform 0 :initarg :total-hours :accessor total-hours)
    (client-totals :initarg :client-totals :accessor client-totals :initform (make-hash-table :test 'equalp))))
 
84d8b868
 (defclass report ()
   ((status-calculator :initarg :status-calculator :accessor status-calculator)
    (status-lines :initform nil :accessor :status-lines)
    (entries :initform nil :accessor :entries)))
 
b9ab1c24
 (defun make-status-calculator (rate)
   (make-instance 'status-calculator :rate rate))
b411883d
 
 (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)))
 
22ca52e0
 (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)))))
 
74adbb8b
 (define-condition incomplete-entry-warning (warning) ()
   (:report (lambda (condition stream)
              (declare (ignore condition))
              (format stream "Incomplete Entry Found"))))
b411883d
 
 (define-condition parsing-error ()
   ((leftovers :initarg :leftovers :accessor leftovers))
   (:report (lambda (condition stream)
                (format stream "Parse error: ~20s leftover" (leftovers condition)))))
 
b9ab1c24
 (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))))
 
74adbb8b
 #|
 (define-message print-partial-line (client memo duration starts)
   )
 |# 
 
b9ab1c24
 (defgeneric print-entries (entries)
   (:method ((entries list))
    (mapcar #'print-entries entries))
   (:method ((entry partial-entry))
74adbb8b
    (format t "~&~4<~>~a, ~a (currently ~3,2f hours):~%~{~12<~>one starting at ~a~%~}"
b9ab1c24
            (client entry)
            (memo entry)
74adbb8b
            (handler-bind ((incomplete-entry-warning (lambda (c) c (invoke-restart 'duration-to-now))))
              (calculate-duration-in-15mins (duration entry)))
b9ab1c24
            (mapcar
74adbb8b
              (alambda (list (local-time:format-timestring
                               nil it
                               :format '(:year #\/ (:month 2) #\/ (:day 2) #\Space
                                         (:hour 2) #\: (:min 2) #\: (:sec 2)))))
b9ab1c24
              (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))
74adbb8b
   (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))))))))
b9ab1c24
 
 (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))
b411883d