@@ -57,7 +57,9 @@

 (make-simple-equality day-entry :test ==)

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

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

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

+(make-equality date-obj

+  (day-of-week eql)

+  (year) (month) (day))

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

@@ -78,8 +80,21 @@

       (setf amount amnt unit unt)

       it)))

+(define-condition parse-error () ())

+

+(define-condition invalid-day-of-week (parse-error)

+  ((day-of-week :initarg :day-of-week :reader day-of-week))

+  (:report (lambda (condition stream)

+             (format stream "~s is not a valid day of the week"

+                     (day-of-week condition)))))

+

 (defun make-date-obj (day-of-week year month day)

-  (make-instance 'date-obj :day-of-week day-of-week :year year :month month :day day))

+  (let ((day-of-week (subseq day-of-week 0 3)))

+    (if (member day-of-week

+                '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")

+                :test #'string-equal)

+      (make-instance 'date-obj :day-of-week day-of-week :year year :month month :day day)  

+      (error 'invalid-day-of-week :day-of-week day-of-week))))

 (defun make-time-obj (hour minute &optional second)

   (make-instance 'time-obj :hour hour :minute minute :second second))

@@ -103,22 +118,26 @@

             year month day))))

 (define-printer (time-obj s)

-  ()

+  ((with-slots (hour minute second) time-obj

+    (format s "~2,'0d:~2,'0d:~2,'0d"  hour minute second))) 

   ((with-slots (hour minute second) time-obj

     (format s "~2,'0d:~2,'0d:~2,'0d"  hour minute second))))

 (define-printer (day-entry s)

-  ()

+  ((with-slots (date records) day-entry

+    (format s "~d records for ~s" (length records) date))) 

   ((with-slots (date records) day-entry

     (format s "~d records for ~s" (length records) date))))

 (define-printer (time-record s)

-  ()

+  ((with-slots (client) time-record

+    (format s "For ~s" client))) 

   ((with-slots (client) time-record

     (format s "For ~s" client))))

 (define-printer (time-mod s)

-  ()

+  ((with-slots (amount unit) time-mod

+    (format s "~s ~s" amount unit))) 

   ((with-slots (amount unit) time-mod

     (format s "~s ~s" amount unit))))

@@ -314,21 +333,41 @@

     (.identity (coerce (list fi se) 'string))) )

 (defun .date-separator ()

-  (.char= #\-))

+  (.or (.char= #\-)

+       (.char= #\/)))

 (defun .date ()

   (.let* ((dow (.weekday))

+          (_ (.optional (.char= #\,)))

           (_ (.char= #\Space))

           (year (.year))

-          (_ (.date-separator))

+          (sep1 (.date-separator))

           (month (.month))

-          (_ (.date-separator))

+          (sep2 (.date-separator))

           (day (.day)))

     (let ((year (parse-integer year))

           (month (parse-integer month))

           (day (parse-integer day)))

       (.identity (make-date-obj dow year month day)))))

+(st:deftest date-test ()

+  

+  (st:should be == nil

+             (caar (smug:run (.date) "Monday 2020/01-01")))

+   

+

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

+             (caar (smug:run (.date) "Monday, 2020-01-01")))

+   

+

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

+             (caar (smug:run (.date) "Monday 2020-01-01")))

+   

+

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

+             (caar (smug:run (.date) "Monday 2020/01/01")))

+  )

+

 (defun .date-start ()

   (.string= "-- "))

@@ -348,9 +387,9 @@

 (defun .parse-all-records ()

   (.prog1 (.date-records) (.not (.item))))

-(defun parse (data)

-  (alet (run (.date-records) data)

-    (values (caar it) (cdar it))))

+#|(defun parse (data)|#

+#|  (alet (run (.date-records) data)|#

+#|    (values (caar it) (cdar it))))|#

 ;; This will help make sure everything is consumed when

 ;; we don't care about the parser's output.

@@ -594,6 +633,15 @@

   (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

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

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

+

+  (st:should be eql t

+             (== (make-time-obj 00 00 00)

+                 (make-time-obj 00 00 00)))

+

   (st:should be eql t

              (== (make-time-mod 3 "mins")

                  (make-time-mod 3 "mins"))) 

Binary files a/precompiled/timesheet and b/precompiled/timesheet differ

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

    Client #1: Prototype for testing user experience.

 -- Wednesday 2016-01-03

-   start@08:00--12:00,15:30--17:00+30min

+   start@08:00--12:00,15:30--17:00+30min,16:00--

    Client #1: Delivered prototype, reviewed prototype feedback.

    start@12:30--15:00

    Client #2: Discussed user requirements and produce specification.

@@ -15,10 +15,10 @@

 -- Thursday 2016-01-04

    start@08:00--16:54

    Client #1: Implement Facebook Connector

-   start@17:00--21:54

+   start@17:00--21:54,22:00--

    Client #2: Implement prototype and write presentation

 -- Friday 2016-01-05

-   start@11:00--16:54

+   start@11:00--16:54,17:00--

    Client #1: Implement Twitter Connector

@@ -9,11 +9,57 @@

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

 (defvar *rate*)

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

+

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

+

+(defmacro /. (&rest body)

+  (let ((args '())

+        forms)

+    (loop for (head . tail) on body

+          until (eql head '->)

+          do (push head args)

+          finally (setf args (nreverse args))

+          finally (setf forms tail))

+    `(macrolet

+       ((>< (&rest form)

+          (list* (cadr form) (car form) (cddr form))))

+       (lambda ,args ,@forms))))

+

+(define-condition parse-error ()

+  ((leftovers :initarg :leftovers :accessor leftovers))

+  (:report (lambda (condition stream)

+               (format stream "Parse error: ~20s leftover" (leftovers condition)))))

+

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

-      (caar (smug:run (timesheet.parser::.date-records) dest)))))

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

+        (unless (string= leftovers "")

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

+        parsed))))

 (defun unroll-date (date-obj)

   (with-slots (year month day) date-obj

@@ -31,39 +77,47 @@

                (if (string= (slot-value time-mod 'unit) "mins")

                  "minute"

                  "hour")))))

-    (loop for (start-obj end-obj mod) in ranges

+    (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 = (combine-date-time end-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)))

-          nconc (list

-                  (local-time-duration:timestamp-difference end start)

-                  (or time-mod (local-time-duration:duration))))))

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

+             (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 date = (slot-value entry 'date)

-                 nconc (with-slots (year month day) date

-                         (loop for record in (slot-value entry 'records)

-                               collect (with-slots (client memo ranges) record

-                                         `(,date

-                                            ,client

-                                            ,(calculate-rounded-ranges

-                                               (calculate-ranges ranges day month year))

-                                            ,memo))))))))

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

@@ -84,57 +138,106 @@

   (stable-sort results #'local-time:timestamp<

                :key (alambda (apply #'local-time:encode-timestamp

                                     (append '(0 0 0 0)

-                                            (unroll-date (car it)))))))

-

-(defun pprint-results (results status)

-  (let ((clients (make-hash-table))

-        (total-cost 0))

-

-    (labels ((record-client (client hours)

-               (let ((client (make-keyword (string-upcase client))))

-                 (incf (gethash client clients 0) hours)))

-             (total-line (results)

-               (format nil "~26<Total~>:~7,2F hours @ ~7,2F $/hr = $~7,2F"

-                       (loop for (_ client time __) in results

-                             do (progn _ __)

-                             sum time

-                             do (record-client client time)

-                             do (incf total-cost (* time *rate*)))

-                       *rate*

-                       total-cost))

-             (fix-assoc (alist)

-               (mapcar (destructuring-lambda ((client . time))

-                         (list client time *rate* (* time *rate*)))

-                       alist)))

-

-      (format t "~&~:{~4a ~10<~:(~a~)~> ~7,2F hrs ~a~%~}" results)

-      (when status

-        (format t "~120,1,0,'-<~>")

-        (let ((total (total-line results)))

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

-                  (stable-sort

-                    (fix-assoc (hash-table-alist clients))

-                    #'string<

-                    :key (alambda (car it))))

-          (format t total))))))

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

+   (format t "~&~120,1,0,'-<~>~%Partial Entries:~%")

+   (loop for (client . entries) in (group-by-client incompletes)

+         do  (loop for entry in entries

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

+

+(defclass status-calculator ()

+  ((clients :initform (make-hash-table) :accessor clients)

+   (total-cost :initform 0 :accessor total-cost)))

+

+(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 total-line (calc results)

+  (:method ((calc status-calculator) results)

+   (with-accessors ((total-cost total-cost)) calc

+     (format nil "~26<Total~>:~7,2F hours @ ~7,2F $/hr = $~7,2F"

+             (loop for result in results

+                   do (record-client calc (client result) (duration result))

+                   do (incf total-cost (* (duration result) *rate*))

+                   sum (duration result))

+             *rate*

+             total-cost))))

+

+(defun print-status (results)

+  (let ((status-calculator (make-instance 'status-calculator)))

+    (flet ((fix-assoc (alist)

+             (mapcar (destructuring-lambda ((client . time))

+                       (list client

+                             time

+                             *rate*

+                             (* time *rate*)))

+                     alist)))

+      (let ((total (total-line status-calculator results)))

+        (format t "~&~120,1,0,'-<~>~%~:{~:(~26<~a~>~):~7,2F hours @ ~7,2F $/hr = $~7,2F~%~}"

+          (stable-sort (fix-assoc (hash-table-alist (clients status-calculator)))

+                       #'string<

+                       :key (alambda (car it))))

+        (format t total)))))

+

+(defun pprint-results (results incompletes status)

+  (format t "~&~:{~4a ~10<~:(~a~)~> ~7,2F hrs ~a~%~}"

+          (mapcar (alambda (list (date it) (client it) (duration it) (memo it)))

+                  results))

+

+  (when incompletes

+    (print-entries incompletes))

+

+  (when status

+    (print-status results)))

+

+(defun group-by-class (list)

+  (loop with completes = '()

+        with partials  = '()

+        with complete-class = (find-class 'complete-entry)

+        with partial-class = (find-class 'partial-entry)

+        for el in list

+        when (eq (class-of el) complete-class) do (push el completes)

+        when (eq (class-of el) partial-class)  do (push el partials)

+        finally (return (values completes partials))))

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

   (when help

     (show-help)

     (return-from pprint-log))

-  (flet ((sort-results (results)

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

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

            (when client

-             (setf results (stable-sort results #'string-lessp :key #'cadr)))

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

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

-      (pprint-results results status))))

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

+          (*print-pretty* t))

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