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