@@ -8,17 +8,32 @@ The file-format is this:

    Client Name: This is a memo.	

 ```

-Right now the parser is fairly fragile: it reads what it can and fails silently at the first 

-error.  Eventually there'll be better error-handling.

+The parser currently has some rudimentary error handling: it detects invalid indentation (i.e. the lines of

+a record do not begin with either a single tab or three spaces) and it detects invalid times.

+

+Additionally, if run in interactive mode `-i`, when it discovers invalid input, it will prompt for a replacement

+and attempt to correct the error.  Also, with `-W`, it should be able to recover from whitespace errors on its own.

+

+## Todo:

+

+- Expand error handling

+- Add alternative export formats

+- Add querying capabilities

+- Support some notion of sub-tasks

+

+## Examples:

 ```

 % ./timesheet -h

-timesheet, common-lisp version 0:1

-  -c --client                     boolean  Sort by client

-  -r --reverse                    boolean  Reverse sort

-  -s --status                     boolean  Print a summary of the hours worked and the prices

-  -h --help                       boolean  show help

-```

+timesheet file parser, version 0:4

+-c --client                     boolean  Sort by client

+-r --reverse                    boolean  Reverse sort

+-W --ignore-whitespace          boolean  Ignore whitespace errors in input

+-i --interactive                boolean  Run Interactively

+-v --version                    boolean  Version

+-s --status                     boolean  Print a summary of the hours worked and the prices

+-h --help                       boolean  show help

+``

 By default, it orders the log by dates.  With the `-r` option, it displays the dates in descending order:

@@ -51,15 +51,16 @@

                                        (string-join

                                          (list (symbol-name super)

                                                "-schema"))))))

-    `(prog1

-       (defclass ,name ,supers

-         ,(list*

-            '(registry :initform (make-hash-table :test 'equal) :allocation :class)

-            (loop for element in elements

-                  collect `(,element :initarg ,(make-keyword element) :initform nil))))

-       (defclass ,schema-name ,schema-supers ())

-       (defmethod slots-for append ((cls ,schema-name))

-         ',elements))))

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

+       (prog1

+         (defclass ,name ,supers

+           ,(list*

+              '(registry :initform (make-hash-table :test 'equal) :allocation :class)

+              (loop for element in elements

+                    collect `(,element :initarg ,(make-keyword element) :initform nil))))

+         (defclass ,schema-name ,schema-supers ())

+         (defmethod slots-for append ((cls ,schema-name))

+           ',elements)))))

 (define-simple-class task ()

   task_id name description billable rate)

@@ -80,7 +80,14 @@

       (setf amount amnt unit unt)

       it)))

-(define-condition parsing-error (parse-error) ())

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

+  ((failed-chunk :initarg :failed-chunk :reader failed-chunk)))

+

+(define-condition invalid-whitespace (parsing-error) ()

+  (:report (lambda (condition stream)

+             (format stream "~s is invalid whitespace"

+                     (map 'list #'char-code (failed-chunk condition))))))

+

 (define-condition invalid-day-of-week (parsing-error)

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

@@ -155,30 +162,66 @@

 (defun .time-separator ()

   (.char= #\:))

+; TODO: consider adding one-digit hours

 (defun .hour ()

   (.let* ((f (.first-hour-char))

           (s (.digit)))

     (if (or (char/= f #\2) (member s '(#\0 #\1 #\2 #\3))) ;; make sure we don't get 24

-      (.identity (parse-integer (coerce (vector f s) 'string)))

+      (.identity (coerce (vector f s) 'string))

       (.fail))))

 (defun .minute-or-second ()

   (.let* ((f (.first-minute-char))

           (s (.digit)))

-    (.identity (parse-integer (coerce (vector f s) 'string)))))

+    (.identity (coerce (vector f s) 'string))))

 (defun .time-range-separator ()

   (.string= "--"))

-(defun .time ()

+(define-condition invalid-time (parsing-error) ()

+  (:report (lambda (condition stream)

+             (format stream "Not a valid time part ~s"

+                     (failed-chunk condition)))))

+

+(defun .valid-time ()

   (.let* ((hour (.hour))

           (_ (.time-separator))

           (minute (.minute-or-second))

-          #|(_ (.time-separator))|#

           (second (.optional

                     (.progn (.time-separator)

                             (.minute-or-second)))))

-    (.identity (make-time-obj hour minute (or second 0)))))

+    (.identity (list hour minute (if second second "0")))))

+

+(defun .invalid-time ()

+  (flet ((.non-time-character ()

+           (.map 'string

+                 (.and (.not (.or (.time-separator)

+                                  (.char= #\newline)

+                                  (.char= #\space)))

+                       (.item)))))

+    (.let* ((hour (.or (.hour)

+                       (.non-time-character)))

+            (_ (.time-separator))

+            (minute (.or (.minute-or-second)

+                         (.non-time-character)))

+            (second (.optional

+                      (.progn (.time-separator)

+                              (.or (.minute-or-second)

+                                   (.non-time-character))))))

+      (error 'invalid-time

+        :failed-chunk (concatenate 'string

+                                   (string hour) ":"

+                                   (string minute)

+                                   (if second

+                                     (concatenate 'string ":" (string second))

+                                     ""))))))

+

+(defun .time ()

+  (.let* ((time (.or (.valid-time) (.invalid-time))))

+    (.identity

+      (apply #'make-time-obj

+             (mapcar #'parse-integer

+                     time)))))

 (defun .time-unit ()

   (.or

@@ -243,8 +286,26 @@

         (.identity ranges)

         (.fail)))))

+(defun .whitespace-char ()

+  (.or (.char= #\tab) (.char= #\space)))

+

+(defun .whitespace ()

+  (.map 'string (.whitespace-char)))

+

+(defun .valid-initial-space ()

+  (.or (.string= (string #\tab))

+       (.string= "   ")))

+

+(defun .extra-whitespace ()

+  (.let* ((_ (.valid-initial-space))

+          (extra-space (.optional (.whitespace))))

+    (if extra-space

+      (error 'invalid-whitespace :failed-chunk extra-space)

+      (.fail))))  

+

 (defun .initial-space ()

-  (.string= "   "))

+  (.or (.extra-whitespace)

+       (.valid-initial-space)))

 (defun .time-line-start ()

   (.progn (.initial-space)

@@ -395,6 +456,31 @@

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

 (defun cdar-equal (a b) (== (cdar a) (cdar b)))

+(st:deftest initial-space ()

+  (st:should signal invalid-whitespace

+             (smug:parse (.initial-space) "    "))

+

+  (st:should signal invalid-whitespace

+             (smug:parse (.initial-space) (concatenate 'string

+                                                       (string #\tab)

+                                                       " ")))

+

+  (st:should signal invalid-whitespace

+             (smug:parse (.initial-space) (concatenate 'string

+                                                       (string #\tab)

+                                                       (string #\tab))))

+

+  (st:should signal invalid-whitespace

+             (smug:parse (.initial-space) (concatenate 'string

+                                                       (string #\tab)

+                                                       "      ")))

+

+  (st:should be == (string #\tab)

+             (smug:parse (.initial-space) (string #\tab)))

+

+  (st:should be == "   "

+             (smug:parse (.initial-space) "   ")))

+

 (st:deftest memo-test ()

   (st:should be == '(("asdf" . ""))

              (run (.client-name) "asdf:"))

@@ -434,7 +520,7 @@

   (st:should be == '((#\, . ""))

              (run (.range-list-separator) ","))

-  (st:should be == nil

+  (st:should signal invalid-time

              (run (.range-list) "30:00:00"))

   (st:should be == nil

@@ -496,10 +582,19 @@

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

 (should-test:deftest time-test ()

+  (st:should signal invalid-time

+             (run (.time) "00:0a:00"))

+

+  (st:should be == '(((0 0 0) . ""))

+             (handler-bind ((invalid-time

+                              (lambda (x) x

+                                (smug:replace-invalid "00:0a:00" "00:00:00"))))

+               (run (.time) "00:0a:00")))

+

   (st:should be == '((#\: . ""))

              (run (.time-separator) ":"))

-  (st:should be == nil

+  (st:should signal invalid-time

        (run (.time) "30:00:00"))

   (st:should be == '(((0 0 0) . ""))

@@ -533,7 +628,7 @@

   (st:should be == nil

              (run (.minute-or-second) "aa"))

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

+  (st:should be == `(("01" . ""))

              (run (.minute-or-second) "01")))

@@ -563,10 +658,10 @@

   (st:should be == nil

              (run (.hour) "aa"))

-  (st:should be == `((20 . ""))

+  (st:should be == `(("20" . ""))

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

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

+  (st:should be == `(("01" . ""))

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

 (should-test:deftest month-test ()

new file mode 100755

Binary files /dev/null and b/timesheet differ

@@ -2,13 +2,12 @@

 (in-package #:timesheet)

-(ubiquitous:restore '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

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

@@ -23,18 +22,39 @@

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

 (defvar *rate*)

-

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

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

-        (loop

-          (restart-case

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

-              (return parsed)

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

-        parsed))))

+(defparameter *interactive* nil)

+

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

+  (flet ((parse-string (string)

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

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

+                                  (progn (format t "~&Whitespace errors~%")

+                                         (abort))))))

+                            (timesheet.parser::invalid-time

+                              (lambda (c) c

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

+                                  (if *interactive*

+                                    (progn

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

+                                      (finish-output *query-io*)

+                                      (let ((replacement (read-line)))

+                                        (format t "~&Replacing ~s with ~s.~%---~%" time replacement)

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

+                                    (progn

+                                      (format t "~&Time ~a is invalid.~%" time)

+                                      (abort)))))))

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

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

+      (loop

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

+            (return parsed)

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

+      parsed)))

 (defun unroll-date (date-obj)

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

@@ -99,19 +119,21 @@

       (slot-value entry 'records)

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

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

-  (let* ((entries (parse-file file)))

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

+  (let* ((entries (parse-file file ignore-whitespace)))

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

 (defparameter +pprint-log-option-spec+

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

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

+    (("ignore-whitespace" #\W) :type boolean :optional t :documentation "Ignore whitespace errors in input")

+    (("interactive" #\i) :type boolean :optional t :documentation "Run Interactively")

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

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

 (define-message version-message (version)

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

@@ -126,8 +148,7 @@

 (defun sort-by-date (results)

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

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

-                                    (append '(0 0 0 0)

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

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

 (defun group-by-client (incompletes)

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

@@ -196,7 +217,7 @@

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

         (go start))))) ; Recurse

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

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

   (when help

     (show-help)

     (return-from pprint-log))

@@ -211,26 +232,36 @@

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

            (when reverse

              (setf results (nreverse results)))

-           results))

+           results)

+         (get-logs (files)

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

+                 append (get-log file ignore-whitespace)) ))

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

+          (*interactive* interactive)

           (*print-pretty* t))

       (let-each (:be *)

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

-              append (get-log file))

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

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

+

 (defun pprint-log-main (argv)

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

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

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

-    +pprint-log-option-spec+

-    'pprint-log

-    :command-line (cdr argv)

-    :name "timesheet"

-    :rest-arity t))

+  (with-timesheet-configuration ()

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

+      +pprint-log-option-spec+

+      'pprint-log

+      :command-line (cdr argv)

+      :name "timesheet"

+      :rest-arity t)))