@@ -1,16 +1,16 @@

-(defpackage #:timesheet.freshbooks

+(defpackage #:tempores.freshbooks

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

-        #:timesheet.parser)

-  (:import-from #:timesheet #:timesheet)

-  (:export #:timesheet))

+        #:tempores.parser)

+  (:import-from #:tempores #:tempores)

+  (:export #:tempores))

-(in-package :timesheet.freshbooks)

+(in-package :tempores.freshbooks)

 (defvar *api-key*)

 (defvar *endpoint*)

 (defun init ()

-  (ubiquitous:restore 'timesheet)

+  (ubiquitous:restore 'tempores)

   (ubiquitous:value :freshbooks :api-key)

   (ubiquitous:value :freshbooks :endpoint))

@@ -76,13 +76,13 @@

   project_id name description rate bill_method client_id hour_budget

   tasks staff)

-(timesheet.macros:define-printer (task s)

+(tempores.macros:define-printer (task s)

   ((with-slots (task_id name) task

     (format s "~i~a (~a):" name task_id)))

   ((with-slots (task_id name) task

     (format s "~a (~a)" name task_id))))

-(timesheet.macros:define-printer (project s)

+(tempores.macros:define-printer (project s)

   ((with-slots (project_id name tasks) project

     (format s "~i~a (~a):~%~{~a~%~}" name project_id tasks)))

   ((with-slots (project_id name tasks) project

@@ -170,19 +170,19 @@

                  (hash-table-alist *task-registry*))))

     (cdr (assoc name tasks :test #'string-equal))))

-(defun timesheet-to-entries (timesheet-log)

+(defun tempores-to-entries (tempores-log)

   (let ((task-id (get-task-by-name "General")))

-    (loop for entry in timesheet-log

-          for date = (timesheet::date entry)

-          for project = (timesheet::client entry)

-          for note = (timesheet::memo entry)

-          for hours = (timesheet::duration entry)

+    (loop for entry in tempores-log

+          for date = (tempores::date entry)

+          for project = (tempores::client entry)

+          for note = (tempores::memo entry)

+          for hours = (tempores::duration entry)

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

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

+                                 (reverse (tempores.cli::unroll-date date)))

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

 (defun make-entry-updates ()

-  (let ((updates (timesheet-to-entries (timesheet::get-log #p"/home/edwlan/bucket/time.md"))))

+  (let ((updates (tempores-to-entries (tempores::get-log #p"/home/edwlan/bucket/time.md"))))

     (loop for update in updates

           collect (<:request (:method "time_entry.create") update))))

@@ -1,9 +1,9 @@

-(defpackage #:timesheet.ql

+(defpackage #:tempores.ql

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

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

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

-(in-package #:timesheet.ql)

+(in-package #:tempores.ql)

 (defstruct (ql-clause (:type vector))

   clause-type clause-parts)

@@ -1,4 +1,4 @@

-(in-package #:timesheet.macros)

+(in-package #:tempores.macros)

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

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

@@ -1,4 +1,4 @@

-(in-package #:timesheet)

+(in-package #:tempores)

 (defclass status-calculator ()

   ((rate :initarg :rate :accessor rate)

@@ -1,6 +1,6 @@

 #|

-(in-package :timesheet.mvc)

+(in-package :tempores.mvc)

 (defclass model () ())

@@ -1,45 +1,45 @@

 ;;;; package.lisp

-(defpackage #:timesheet.packages

+(defpackage #:tempores.packages

   (:use #:cl))

-(in-package #:timesheet.packages)

+(in-package #:tempores.packages)

 (defpackage #:generic-equals

   (:use #:cl)

   (:export #:==))

-(defpackage #:timesheet.macros

+(defpackage #:tempores.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.parser

+(defpackage #:tempores.parser

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

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

+        #:tempores.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

+(defpackage #:tempores.mvc

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

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

-(defpackage #:timesheet

+(defpackage #:tempores

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

-        #:timesheet.parser)

+        #:tempores.parser)

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

-  (:export #:with-timesheet-configuration #:pprint-log #:get-log #:timesheet

+  (:export #:with-tempores-configuration #:pprint-log #:get-log #:tempores

            #:*default-time-sheet-file* #:*rate* #:group-by-class #:print-status

            #:print-entries #:autocorrect-warning))

-(defpackage #:timesheet.cli

+(defpackage #:tempores.cli

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

-        #:timesheet.parser #:timesheet #:net.didierverna.clon

+        #:tempores.parser #:tempores #:net.didierverna.clon

         #:plambda)

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

-(in-package #:timesheet)

+(in-package #:tempores)

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

 (defvar *rate*)

@@ -1,4 +1,4 @@

-(in-package #:timesheet.parser)

+(in-package #:tempores.parser)

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

   ;; make sure these classes am ready to go!

similarity index 88%

rename from timesheet.asd

rename to tempores.asd

@@ -1,8 +1,8 @@

 (in-package :asdf-user)

-;;;; timesheet.asd

+;;;; tempores.asd

-(asdf:defsystem #:timesheet

-  :description "Describe timesheet here"

+(asdf:defsystem #:tempores

+  :description "Describe tempores here"

   :author "fiddlerwoaroof"

   :license "MIT"

   :depends-on (#:alexandria

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

                (:file "mvc")

                (:file "main-classes")  

                (:file "freshbooks")  

-               (:file "timesheet")))

+               (:file "tempores")))

 ;; vim: set ft=lisp:

@@ -1,4 +1,4 @@

-(in-package #:timesheet.parser)

+(in-package #:tempores.parser)

 ;; This will help make sure everything is consumed when

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

deleted file mode 100755

Binary files a/timesheet and /dev/null differ

deleted file mode 100644

@@ -1,229 +0,0 @@

-(in-package #:timesheet.cli)

-

-(defparameter *interactive* nil)

-(defparameter *version* "0:7")

-

-(defun unroll-date (date-obj)

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

-    (list day month year)))

-

-(defun split-time (time)

-  (let ((time-parts (split-sequence #\: time)))

-    (destructuring-bind (hours minutes . optional-seconds) time-parts

-      (let ((hours (parse-integer hours))

-            (minutes (parse-integer minutes))

-            (seconds (parse-integer (or (car optional-seconds) "0")))

-            (extra (cdr optional-seconds)))

-        (values hours minutes seconds extra)))))

-

-(defun try-fix-time (failed-time)

-  (handler-case

-    (multiple-value-bind (hours minutes seconds extra) (split-time failed-time)

-      (if (and (< hours 24) (< minutes 60) (< seconds 60) (null extra))

-        (values (format nil "~2,'0d:~2,'0d:~2,'0d" hours minutes seconds) t)

-        (values nil nil)))

-    (parse-error (c) c (values nil nil))))

-

-(defun call-with-prompt (stream prompt args cb)

-  (apply #'format stream prompt args)

-  (finish-output *query-io*)

-  (funcall cb (read-line *query-io*)))

-

-(defmacro with-prompt ((result-sym stream prompt &rest args) &body body)

-  `(call-with-prompt ,stream ,prompt (list ,@args)

-                     (lambda (,result-sym)

-                       ,@body)))

-

-(defun abort-with-message (stream message &rest args)

-  (apply #'format stream message args)

-  (abort))

-

-(define-condition parse-time-error (parse-error)

-  ((time-string :initarg :time-string :accessor time-string))

-  (:report (lambda (condition stream)

-             (format stream "Time input did not parse correctly: ~s" (time-string condition)))))

-

-(defun call-with-prompt-for-time (stream prompt args cb)

-  (call-with-prompt

-    stream prompt args

-    (lambda (time-string)

-      (multiple-value-bind (hours minutes seconds extra) (split-time time-string)

-        (funcall cb hours minutes seconds extra)))))

-

-(defmacro with-prompt-for-time ((result-syms stream prompt &rest args) &body body)

-  `(call-with-prompt-for-time ,stream ,prompt (list ,@args)

-                              (lambda (,@result-syms)

-                                ,@body)))

-

-(define-message format-time (hours minutes &optional (seconds 0))

-  (:decimal 2 '0) #\: (:decimal 2 '0) #\: (:decimal 2 '0))

-

-(defun handle-invalid-time (c) c

-  (let ((time (timesheet.parser::failed-chunk c)))

-    (multiple-value-bind (new-value success) (try-fix-time time)

-      (when success

-        (progn (warn 'timesheet::autocorrect-warning

-                     :old-value time

-                     :new-value new-value)

-               (smug:replace-invalid time new-value))))

-    (if *interactive*

-      (loop

-        (handler-case

-          (with-prompt-for-time ((hours minutes seconds &rest rest)

-                                 *query-io* "Invalid time ~a, replacement? " time)

-            (declare (ignore rest))

-            (let ((replacement (format-time nil hours minutes seconds)))

-              (format *query-io* "~&Replacing ~s with ~s.~%---~%" time replacement)

-              (smug:replace-invalid time replacement)))

-          (parse-error (c) c (format t "~&Invalid entry.~%"))))

-      (abort-with-message t "~&Time ~a is invalid.~%" time))))

-

-(defun handle-invalid-whitespace (ignore-whitespace-errors)

-  (lambda (c) c

-    (let ((extra-whitespace (timesheet.parser::failed-chunk c)))

-      (if (or ignore-whitespace-errors

-              (when *interactive*

-                (y-or-n-p "Invalid extra whitespace ~s, truncate?" extra-whitespace)))

-        (smug:replace-invalid extra-whitespace "")

-        (abort-with-message t "~&Whitespace errors~%")))))

-

-(defun parse-file (&optional (file *default-time-sheet-file*) ignore-whitespace-errors)

-  (flet ((parse-string (string)

-           (handler-bind ((timesheet.parser::invalid-whitespace

-                            (handle-invalid-whitespace ignore-whitespace-errors))

-                          (parse-error #'handle-invalid-time)

-                          (timesheet.parser::invalid-time #'handle-invalid-time) )

-             (smug:parse (timesheet.parser::.date-records) string))))

-    (multiple-value-bind (parsed leftovers) (parse-string (read-file-into-string file))

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

-        parsed

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

-

-(defun pprint-results (results incompletes status)

-  (print-entries results)

-

-  (when incompletes

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

-    (print-entries incompletes))

-

-  (when status

-    (print-status results)))

-

-(defun sort-by-date (results)

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

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

-                                    (list* 0 0 0 0 (unroll-date (date it)))))))

-

-(defun maybe-nreverse (flag list)

-  (if flag

-    (nreverse list)

-    list))

-

-(define-modify-macro maybe-nreversef (flag)

-                     (lambda (place flag)

-                       (maybe-nreverse flag place)))

-

-(defun list-without-nulls (&rest items)

-  (loop for item in items

-        when item collect item))

-

-(defun pprint-log (args &key client reverse status ignore-whitespace interactive)

-  (labels ((sort-func (client)

-             (apply #'compose

-                    (list-without-nulls

-                      (when reverse #'nreverse)

-                      (when client

-                        (plambda (stable-sort :1 #'string-lessp :key #'client)))

-                      #'sort-by-date)))

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

-             (funcall (sort-func client) results))

-           (get-logs (files)

-             (loop for file in (ensure-list files)

-                   append (timesheet:get-log file ignore-whitespace)) ))

-

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

-          (*interactive* interactive)

-          (*print-pretty* t))

-      (let-each (:be *)

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

-        (group-by-class *)

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

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

-                (incomplete-results (sort-results incomplete-ranges t)))

-            (pprint-results complete-results incomplete-results status)))))))

-

-(defsynopsis (:postfix "TIMESHEETS ...")

-  (text :contents "A program for managing logs of hours worked")

-  (group (:header "Display options")

-         (flag :short-name "s" :long-name "status"

-               :description "Print a short summary of work status")

-         (flag :short-name "W"

-               :long-name "ignore-whitespace"

-               :description "Ignore whitespace errors in input")

-         (flag :short-name "i" :long-name "interactive"

-               :description "Run interactively"))

-  (group (:header "Sort options")

-         (flag :short-name "r"

-               :long-name "reverse"

-               :description "Reverse the sort direction")

-         (flag :short-name "c"

-               :long-name "client"

-               :description "Sort records by client"))

-  (group (:header "Freshbooks")

-         (flag :long-name "post-hours"

-               :description "Post hours to freshbooks (requires manual setup of Freshbooks keys)"))

-  (group (:header "Self-test options")

-         (flag :long-name "run-tests"

-               :description "Run the tests")

-         (enum :long-name "output-style"

-               :description "The kind of output to produce"

-               :default-value :normal

-               :enum '(:xunit :normal)))

-  (group (:header "Generic options")

-         (flag :short-name "v" :long-name "version"

-               :description "Show the program version")

-         (flag :short-name "h" :long-name "help"

-               :description "Show this help")))

-

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

-  (define-message version-message (version)

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

-

-(defun show-version ()

-  (version-message t *version*))

-

-(defun tests-main (&optional (output-style nil output-style-p))

-  (let ((should-test:*verbose* t))

-    (ecase output-style

-      (:xunit (should-test:test-for-xunit *standard-output* :package :timesheet.parser))

-      (:normal (should-test:test :package :timesheet.parser)))))

-

-(defun pprint-log-main ()

-  (make-context)

-  (tagbody

-    start

-    (restart-case

-      (cond

-        ((getopt :long-name "help") (help))

-        ((getopt :long-name "version") (show-version))

-        ((getopt :long-name "post-hours") (let ((*print-pretty* nil))

-                                            (loop for item in (timesheet.freshbooks::post-time-entries-main)

-                                                  do (format t "Posted an entry")

-                                                  do (plump:serialize item)

-                                                  finally (format t "Don't forget to archive time file."))))

-        ((getopt :long-name "run-tests") (tests-main (getopt :long-name "output-style")))

-        (t (with-timesheet-configuration ()

-             (pprint-log

-               (remainder)

-               :client (getopt :long-name "client")

-               :interactive (getopt :long-name "interactive")

-               :ignore-whitespace (getopt :long-name "ignore-whitespace")

-               :status (getopt :long-name "status")

-               :reverse (getopt :long-name "reverse")))))

-      (retry () (go start))

-      (abort ()))))

-

-(defun make-executable ()

-  (dump "timesheet" pprint-log-main

-        :compression 8

-        :purify t))

deleted file mode 100644

@@ -1,151 +0,0 @@

-;; timesheet.lisp

-

-(in-package #:timesheet)

-

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

-   (entries :initform nil :accessor :entries)))

-

-(defun combine-date-time (time-obj day month year)

-  (declare (optimize (debug 3)))

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

-    (local-time:encode-timestamp 0 second minute hour

-                                 day month year)))

-

-(defun calculate-ranges (ranges date)

-  (declare (optimize (debug 3)))

-  (labels ((time-mod-unit-keyword (time-mod)

-             (make-keyword

-               (string-upcase

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

-                   "minute"

-                   "hour"))))

-           (make-mod (mod)

-             (when mod

-               (let ((unit (time-mod-unit-keyword mod))

-                     (amount (slot-value mod 'timesheet.parser:amount)))

-                 (funcall #'local-time-duration:duration unit amount)))))

-    (with-slots (year month day) date

-      (loop with complete = nil

-        with partial = nil

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

-        for start = (combine-date-time start-obj day month year)

-        for end = (when end-obj (combine-date-time end-obj day month year))

-        for time-mod = (when mod (make-mod mod))

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

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

-   (incomplete :initarg :incomplete)))

-

-(defun get-entry-ranges (entry)

-  (flet ((make-entry (record)

-           (let ((date (slot-value entry 'date)))

-             (with-slots (client memo ranges) record

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

-                 (list*

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

-                   (maybe-list partial

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

-    (let-each (:be *)

-      (slot-value entry 'records)

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

-

-(defun get-log (&optional (file *default-time-sheet-file*) ignore-whitespace)

-  (let* ((entries (timesheet.cli::parse-file file ignore-whitespace)))

-    (mapcan #'get-entry-ranges entries)))

-

-(defun group-by-client (incompletes)

-  (let ((results (make-hash-table :test 'equalp)))

-    (loop for incomplete in incompletes

-          for client = (client incomplete)

-          do (push incomplete (gethash client results)))

-    (hash-table-alist results)))

-

-(defun update-clients (status-calculator entry)

-  (flet ((ensure-client (client)

-           (ensure-gethash client

-                           (client-totals status-calculator)

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

-    (with-accessors ((client client)) entry

-      (let ((client-hash-table (ensure-client client)))

-        (update client-hash-table entry)))))

-

-(defun calculate-results (results &optional (rate *rate*))

-  (let-first (:be status-calculator) (make-status-calculator rate)

-    (dolist (result results)

-      (update-clients status-calculator result)

-      (update status-calculator result))))

-

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

-         (client-totals (client-totals status-calculator)))

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

-               (with-slots (client duration) 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-each (:be *)

-        (print-separator)

-        (hash-table-keys client-totals)

-        (sort * #'string-lessp)

-        (dolist (client *)

-          (print-status-line (gethash client client-totals)))

-        (format t (total-line status-calculator *rate*))))))

-

-

-(defun group-by-class (list &optional accum1 accum2)

-  (tagbody ; Let's do some TCO ...

-    start

-    (if (null list)

-      (return-from group-by-class (list accum1 accum2))

-      (destructuring-bind (head . tail) list

-        (etypecase head

-          (complete-entry (setf accum1 (cons head accum1))) ; Here we set the accumulators

-          (partial-entry (setf accum2 (cons head accum2)))) ;  to the appropriate values.

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

-        (go start))))) ; Recurse

-

-(defmacro with-timesheet-configuration (() &body body)

-  `(progn

-     (ubiquitous:restore 'timesheet)

-     (let ((*rate* (ubiquitous:defaulted-value 0 :rate))

-           (*default-time-sheet-file*

-             (ubiquitous:defaulted-value #p"~/time.md" :timesheet :file)))

-       ,@body)))

-