@@ -153,9 +153,10 @@

 (defun make-time-entry (project task date hours notes)

   (<:time_entry ()

                 (<:project_id ()

-                              (slot-value (get-project project)

-                                          'project_id))

-                (<:task_id () (identity task))

+                              (parse-integer

+                                (slot-value (get-project project)

+                                            'project_id)))

+                (<:task_id () (parse-integer task))

                 (<:date () (identity date))

                 (<:hours () (identity hours))

                 (<:notes () (identity notes))))

@@ -175,7 +176,7 @@

           for project = (timesheet::client entry)

           for note = (timesheet::memo entry)

           for hours = (timesheet::duration entry)

-          for fmt-date = (format nil "~:@{~2,'0d-~2,'0d-~2,'0d~}"

+          for fmt-date = (format nil "~:@{~2,'0d-~2,'0d-~2,'0d 00:00:00~}"

                                  (reverse (timesheet::unroll-date date)))

           collect (make-time-entry project task-id fmt-date hours note))))

@@ -4,7 +4,7 @@

   `(defmethod == ((a ,class) (b ,class))

      (declare (optimize (speed 3)))

      (and ,@(loop for (slot . test) in test-defs

-                  with test-val = (or (car test) 'eql)

+                  for test-val = (or (car test) 'eql)

                   collect `(,test-val (slot-value a ',slot)

                                       (slot-value b ',slot))))))

@@ -23,7 +23,10 @@

 (defclass partial-entry (parsed-entry)

   ((start-times :initarg :start-times :initform nil :accessor start-times)))

-(define-condition incomplete-entry-warning (warning) ())

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

@@ -40,18 +43,25 @@

   (: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:~%~{~12<~>one starting at ~a~%~}"

+   (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 (local-time:format-timestring

-                        nil it

-                        :format '(:year #\/ (:month 2) #\/ (:day 2) #\Space

-                                  (:hour 2) #\: (:min 2) #\: (:sec 2))))

+             (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~%"

@@ -71,8 +81,16 @@

 (defmethod duration ((obj partial-entry))

-  (warn "incomplete entry detected for ~a" (client obj))

-  (local-time-duration:duration))

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

@@ -27,4 +27,5 @@

 (defpackage #:timesheet

   (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils

-        #:timesheet.parser))

+        #:timesheet.parser)

+  (:import-from #:format-string-builder #:define-message))

@@ -58,7 +58,7 @@

 (make-simple-equality time-record :test ==)

 (make-simple-equality time-obj :test eql)

 (make-equality date-obj

-  (day-of-week eql)

+  (day-of-week ==)

   (year) (month) (day))

 (make-simple-equality time-mod :test equal)

@@ -378,8 +378,8 @@

 (defun .date-record ()

   (.let* ((date (.date-line))

-         (records (.records)))

-    (.identity (make-day-entry date records))))

+          (records (.records)))

+         (.identity (make-day-entry date records))))

 (defun .date-records ()

   (.first (.map 'list (.date-record))))

@@ -625,7 +625,9 @@

   (st:should be == `(((,(make-time-obj 0 0 0) ,(make-time-obj 1 0 0) ,(make-time-mod -10 "mins")) . ""))

              (run (.time-range) "00:00--01:00-10mins")))

-(st:deftest == ()

+(st:deftest generic-eq ()

+  "Note: this really should be in the equality package with the name ==

+   should-test only checks tests for _internal_ symbols."

   (st:should be eql t (== #\1 #\1))

   (st:should be eql t (== 1 1))

   (st:should be eql t (== "1" "1"))

@@ -633,6 +635,7 @@

   (st:should be eql t (== #("1") #("1")))

   (st:should be eql t (== '(1 . 2) '(1 . 2)))

   (st:should be eql t (== '((1 . 2)) '((1 . 2))))

+  (st:should be eql t (== #1=(make-date-obj "Monday" 2020 01 01) #1#))

   (st:should be eql t

              (== (make-date-obj "Monday" 2012 01 01)

deleted file mode 100755

Binary files a/timesheet and /dev/null differ

@@ -6,21 +6,22 @@

   :author "fiddlerwoaroof"

   :license "MIT"

   :depends-on (#:alexandria

-               #:serapeum

                #:anaphora

+               #:cells

+               #:command-line-arguments

+               #:drakma

+               #:format-string-builder

+               #:fwoar.lisputils

+               #:local-time-duration

+               #:lquery

+               #:manardb

                #:ningle

-               #:spinneret

+               #:serapeum

                #:should-test

-               #:fwoar.lisputils

                #:smug

-               #:cells

+               #:spinneret

                #:ubiquitous

-               #:command-line-arguments

-               #:manardb

-               #:local-time-duration

                #:xhtmlambda

-               #:drakma

-               #:lquery

                )

   :serial t

   :components ((:file "package")

@@ -6,6 +6,16 @@

 ;;; "timesheet" 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)))))

+

 (defclass report ()

   ((status-calculator :initarg :status-calculator :accessor status-calculator)

    (status-lines :initform nil :accessor :status-lines)

@@ -19,8 +29,11 @@

     (let ((dest (make-string (file-length s))))

       (read-sequence dest s)

       (multiple-value-bind (parsed leftovers) (smug:parse (timesheet.parser::.date-records) dest)

-        (unless (or (null leftovers) (string= leftovers ""))

-          (cerror "Continue?" 'parsing-error :leftovers leftovers))

+        (loop

+          (restart-case

+            (if (or (null leftovers) (string= leftovers ""))

+              (return parsed)

+              (cerror "Continue?" 'parsing-error :leftovers leftovers))))

         parsed))))

 (defun unroll-date (date-obj)

@@ -58,18 +71,16 @@

             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)

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

-

-(defmacro list-or-null (test val)

-  `(when ,test

-     (list ,val)))

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

@@ -82,8 +93,8 @@

                (multiple-value-bind (complete partial) (calculate-ranges ranges date)

                  (list*

                    (make-complete-entry date client memo (calculate-rounded-ranges complete))

-                   (list-or-null partial

-                                 (make-partial-entry date client memo partial))))))))

+                   (maybe-list partial

+                               (make-partial-entry date client memo partial))))))))

     (let-each (:be *)

       (slot-value entry 'records)

       (mapcan #'make-entry *))))

@@ -95,13 +106,18 @@

 (defparameter +pprint-log-option-spec+

   '((("client" #\c) :type boolean :optional t :documentation "Sort by client")

     (("reverse" #\r) :type boolean :optional t :documentation "Reverse sort")

+    (("version" #\v) :type boolean :optional t :documentation "Version")

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

+(defparameter *version* "0:3")

+

+(define-message version-message (version)

+  (:own-line () "timesheet file parser, version " :str))

+

 (defun show-version ()

-  (format t "timesheet, common-lisp version ~a~%" *version*))

+  (version-message t *version*))

 (defun show-help ()

   (show-version)

@@ -122,7 +138,7 @@

 (defun update-clients (status-calculator entry)

   (flet ((ensure-client (client)

-           (ensure-gethash client 

+           (ensure-gethash client

                            (client-totals status-calculator)

                            (make-instance 'status-line :client client))))

     (with-accessors ((client client)) entry

@@ -135,19 +151,18 @@

       (update-clients status-calculator result)

       (update status-calculator result))))

-;;   Uses the first arg as a list. Adds 26 blanks to left

-(defparameter +status-line-format-string+ "~&~:@{~:(~26<~a~>~):~7,2F hours @ ~7,2F $/hr = $~7,2F~}~%") 

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

-    (labels ((status-line-format (&rest args)

-               (format t +status-line-format-string+ args))

-             (print-status-line (status-line)

+    (labels ((print-status-line (status-line)

                (with-slots (client duration) status-line

-                 (status-line-format

-                   client

-                   duration

-                   (rate status-calculator)

-                   (calculate-cost status-calculator 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 ((client-totals (client-totals status-calculator)))

@@ -181,11 +196,15 @@

         (setf list tail) ; Here we step towards the terminating condition

         (go start))))) ; Recurse

-(defun pprint-log (args &key client reverse status help)

+(defun pprint-log (args &key client reverse status help version)

   (when help

     (show-help)

     (return-from pprint-log))

+  (when version

+    (show-version)

+    (return-from pprint-log))

+

   (flet ((sort-results (results &optional (client client))

            (setf results (sort-by-date results))

            (when client

@@ -194,10 +213,11 @@

              (setf results (nreverse results)))

            results))

-    (let ((*default-time-sheet-file* (or (car args) *default-time-sheet-file*))

+    (let ((*default-time-sheet-file* (or args *default-time-sheet-file*))

           (*print-pretty* t))

       (let-each (:be *)

-        (get-log *default-time-sheet-file*)

+        (loop for file in (ensure-list *default-time-sheet-file*)

+              append (get-log file))

         (group-by-class *)

         (destructuring-bind (complete-ranges incomplete-ranges) *

           (let ((complete-results (sort-results complete-ranges client))

deleted file mode 100755

Binary files a/utils/buildapp and /dev/null differ