new file mode 100644

@@ -0,0 +1,15 @@

+(in-package #:generic-equals)

+

+(defgeneric == (a b)

+  (:method (a b) (eql a b))

+  (:method ((a list) (b list))

+   (declare (optimize (speed 3) (space 3)))

+   (if (or (null a) (null b))

+     (and (null a) (null b))

+     (and (== (car a) (car b))

+          (== (cdr a) (cdr b)))))

+  (:method ((a vector) (b vector))

+   (declare (optimize (speed 3) (space 3)))

+   (every #'identity (map 'vector #'== a b))))

+

+

new file mode 100644

@@ -0,0 +1,41 @@

+(in-package #:timesheet.macros)

+

+(defmacro make-equality (class &body test-defs)

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

+     (declare (optimize (speed 3)))

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

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

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

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

+

+(defmacro make-simple-equality (class &key (test 'eql) &environment env)

+  (let ((class-def (find-class class t env)))

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

+       (declare (optimize (speed 3)))

+       (and ,@(loop for slot in (closer-mop:class-direct-slots class-def)

+                    collect (let ((slot (closer-mop:slot-definition-name slot)))

+                              `(,test (slot-value a ',slot)

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

+

+(defmacro defmethod-and-inverse (name (arga argb) &body body)

+  `(progn

+     (defmethod ,name (,arga ,argb)

+       (declare (optimize (speed 3)))

+       ,@body)

+     (defmethod ,name (,argb ,arga)

+       (declare (optimize (speed 3)))

+       ,@body)))

+

+(defmacro define-printer ((obj stream &key (type t) (identity t)) (&body pretty) (&body normal))

+  `(defmethod print-object ((,obj ,obj) ,stream)

+     (if *print-pretty*

+       (progn

+         ,@pretty)

+       (print-unreadable-object (,obj ,stream :type ,type :identity ,identity)

+         ,@normal))))

+

+(defmacro quick-equalities (&body defs)                        

+  `(progn                                                     

+     ,@(loop for (name test)  in defs                         

+             collect (list 'make-equality name :test test)))) 

+

@@ -1,13 +1,26 @@

 ;;;; package.lisp

+(defpackage #:generic-equals

+  (:use #:cl)

+  (:export #:==))

-(defpackage #:timesheet.parser

-  (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils #:smug)

-  )

+(defpackage #:timesheet.macros

+  (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils #:generic-equals)

+  (:export #:make-equality #:make-simple-equality #:defmethod-and-inverse

+           #:define-printer #:quick-equalities))

-(defpackage #:timesheet

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

-  )

+

+(defpackage #:timesheet.parser

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

+        #:timesheet.macros #:generic-equals)

+  (:shadow #:parse)

+  (:export #:parse #:unparse #:date #:records #:client #:ranges #:memo #:hour #:minute #:second

+           #:day-of-week #:year #:month #:day #:amount #:unit))

 (defpackage #:timesheet.mvc

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

   (:export #:model #:view #:controller #:display #:operate #:has-changed))

+

+(defpackage #:timesheet

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

+        #:timesheet.parser))

+

@@ -1,38 +1,7 @@

 (in-package #:timesheet.parser)

-(defgeneric == (a b)

-  (:method (a b) (eql a b))

-  (:method ((a list) (b list))

-   (if (or (null a) (null b))

-     (and (null a) (null b))

-     (and (== (car a) (car b))

-          (== (cdr a) (cdr b)))))

-  (:method ((a vector) (b vector)) (every #'identity (map 'vector #'== a b))))

-

-(defmacro make-equality (class &body test-defs &environment env)

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

-     (declare (optimize (speed 3)))

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

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

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

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

-

-(defmacro make-simple-equality (class &key (test 'eql) &environment env)

-  (let ((class-def (find-class class t env)))

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

-       (declare (optimize (speed 3)))

-       (and ,@(loop for slot in (closer-mop:class-direct-slots class-def)

-                    collect (let ((slot (closer-mop:slot-definition-name slot)))

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

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

-

-#|(defmacro make-equalities (&body defs)                        |#

-#|  `(progn                                                     |#

-#|     ,@(loop for (name test)  in defs                         |#

-#|             collect (list 'make-equality name :test test)))) |#

-

 (eval-when (:compile-toplevel :load-toplevel :execute)

-

+  ;; make sure these classes am ready to go!

   (defclass day-entry ()

     ((date :initarg :date)

      (records :initarg :records)))

@@ -92,26 +61,6 @@

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

-(st:deftest == ()

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

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

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

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

-  (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-time-mod 3 "mins")

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

-  (st:should be eql t

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

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

-  (st:should be eql t

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

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

-

-

-

 (defun make-day-entry (date records)

   (make-instance 'day-entry :date date :records records))

@@ -135,15 +84,6 @@

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

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

-(defmacro defmethod-and-inverse (name (arga argb) &body body)

-  `(progn

-     (defmethod ,name (,arga ,argb)

-       (declare (optimize (speed 3)))

-       ,@body)

-     (defmethod ,name (,argb ,arga)

-       (declare (optimize (speed 3)))

-       ,@body)))

-

 (defmethod-and-inverse == ((date-obj date-obj) (list list))

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

     (every #'== (list day-of-week year month day) list)))

@@ -152,40 +92,35 @@

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

     (every #'== (list hour minute second) list)))

-(defmacro define-printer ((obj stream &key (type t) (identity t)) &body body)

-  `(defmethod print-object ((,obj ,obj) ,stream)

-     (print-unreadable-object (,obj ,stream :type ,type :identity ,identity)

-       ,@body)))

-

 (define-printer (date-obj s)

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

-    (format s "~a, ~2,'0d/~2,'0d/~2,'0d" (subseq

-                                           (string-capitalize day-of-week)

-                                           0 3)

-            year month day)))

+  ((with-slots (day-of-week year month day) date-obj

+     (format s "~a, ~2,'0d/~2,'0d/~2,'0d"

+             (subseq (string-capitalize day-of-week) 0 3)

+             year month day)))

+  ((with-slots (day-of-week year month day) date-obj

+    (format s "~a, ~2,'0d/~2,'0d/~2,'0d"

+            (subseq (string-capitalize day-of-week) 0 3)

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

-(defmethod print-object ((obj day-entry) s)

-  (print-unreadable-object (obj s :type t :identity t)

-    (with-slots (date records) obj

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

+(define-printer (day-entry s)

+  ()

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

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

-(defmethod print-object ((obj time-record) s)

-  (print-unreadable-object (obj s :type t :identity t)

-    (with-slots (client) obj

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

+(define-printer (time-record s)

+  ()

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

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

-(defmethod print-object ((obj time-mod) s)

-  (print-unreadable-object (obj s :type t :identity t)

-    (with-slots (amount unit) obj

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

-

-;; Time:

-;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

-;; [0-2][0-9]:[0-6][0-8]:[0-6][0-6]

+(define-printer (time-mod s)

+  ()

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

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

 (defun .digit ()

   (.is #'digit-char-p))

@@ -386,7 +321,10 @@

           (month (.month))

           (_ (.date-separator))

           (day (.day)))

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

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

+          (month (parse-integer month))

+          (day (parse-integer day)))

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

 (defun .date-start ()

   (.string= "-- "))

@@ -571,3 +509,22 @@

   (st:should be == `((1 . ""))

              (run (.prog1 (.hour) (.not (.item))) "01")))

+

+(st:deftest == ()

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

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

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

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

+  (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-time-mod 3 "mins")

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

+  (st:should be eql t

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

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

+  (st:should be eql t

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

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

+

@@ -14,9 +14,15 @@

                #:fwoar.lisputils

                #:smug

                #:cells

-               #:manardb)

+               #:ubiquitous

+               #:command-line-arguments

+               #:manardb

+               #:local-time-duration

+               )

   :serial t

   :components ((:file "package")

+               (:file "generic-equals")

+               (:file "macros")

                (:file "parser")

                (:file "mvc")

                (:file "timesheet")))

@@ -2,5 +2,130 @@

 (in-package #:timesheet)

+(ubiquitous:restore 'timesheet)

+

 ;;; "timesheet" goes here. Hacks and glory await!

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

+(defvar *rate*)

+

+(defun parse-file (&optional (file *default-time-sheet-file*))

+  (with-open-file (s *default-time-sheet-file* :direction :input)

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

+      (read-sequence dest s)

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

+

+(defun unroll-date (date-obj)

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

+    (list day month year)))

+

+(defun calculate-ranges (ranges year month day)

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

+        for start = (local-time:encode-timestamp 0 

+                                                 (slot-value start-obj 'second)

+                                                 (slot-value start-obj 'minute)

+                                                 (slot-value start-obj 'hour)

+                                                 day month year)

+        for end = (local-time:encode-timestamp 0

+                                               (slot-value end-obj 'second)

+                                               (slot-value end-obj 'minute)

+                                               (slot-value end-obj 'hour)

+                                               day month year )

+        for time-mod = (when time-mod

+                         (let ((unit (make-keyword

+                                       (string-upcase

+                                         (if (string= (slot-value time-mod 'timesheet.parser::unit) "mins")

+                                           "minute"

+                                           "hour"))))

+                               (amount (slot-value time-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)))))

+

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

+

+(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 year month day))

+                                            ,memo))))))))

+

+(defparameter +pprint-log-option-spec+

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

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

+    (("status" #\s) :type boolean :optional t :documentation "status")))

+

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

+(defun show-version ()

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

+

+(defun show-help ()

+  (show-version)

+  (command-line-arguments:show-option-help +pprint-log-option-spec+ :sort-names t))

+

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

+  (when help

+    (show-help)

+    (return-from pprint-log))

+

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

+         (*print-pretty* t)

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

+         (clients (make-hash-table))

+         (total-cost 0))

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

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

+                                                    (append '(0 0 0 0)

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

+    (when client

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

+    (when reverse

+      (setf results (nreverse results)))

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

+    (flet ((record-client (client hours)

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

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

+      (when status

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

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

+                             (loop for (_ client time ___) in results

+                                   sum time

+                                   do (record-client client time)

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

+                             *rate*

+                             total-cost)))

+          (flet ((fix-assoc (alist)

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

+                             (list client time *rate* (* time *rate*)))

+                           alist)))

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

+

+(defun pprint-log-main (argv)

+  (setf *default-time-sheet-file* (ubiquitous:defaulted-value "" :timesheet :file))

+  (setf *rate* (ubiquitous:defaulted-value 40 :rate))

+  (command-line-arguments:handle-command-line

+    +pprint-log-option-spec+

+    'pprint-log

+    :command-line (cdr argv)

+    :name "timesheet"

+    :rest-arity t))