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

   (ubiquitous:value :freshbooks :api-key)

   (ubiquitous:value :freshbooks :endpoint))

-(xhtmlambda::def-element <::request)

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

+  (xhtmlambda::def-element <::request) 

+  (xhtmlambda::def-element <::time_entry)

+  (xhtmlambda::def-element <::project_id)

+  (xhtmlambda::def-element <::task_id)

+  (xhtmlambda::def-element <::hours)

+  (xhtmlambda::def-element <::notes)

+  (xhtmlambda::def-element <::date))

 (defun post-to-endpoint (xml)

   (let ((drakma:*text-content-types* (acons "application" "xml" drakma:*text-content-types*)))

@@ -129,13 +136,6 @@

                                        slot-name

                                        (node)))))))

-(xhtmlambda::def-element <::time_entry)

-(xhtmlambda::def-element <::project_id)

-(xhtmlambda::def-element <::task_id)

-(xhtmlambda::def-element <::hours)

-(xhtmlambda::def-element <::notes)

-(xhtmlambda::def-element <::date)

-

 (defun get-project (name)

   (let ((projects (sort (map 'vector

                              (alambda (cons (string-downcase it) it))

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

           for note = (timesheet::memo entry)

           for hours = (timesheet::duration entry)

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

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

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

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

 (defun make-entry-updates ()

new file mode 100644

@@ -0,0 +1,59 @@

+

+(defpackage #:timesheet.ql

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

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

+

+(in-package #:timesheet.ql)

+

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

+  clause-type clause-parts)

+

+(defun .name ()

+  (.map 'string

+        (.is (.or #'alpha-char-p

+                  #'digit-char-p))))

+

+(defun .order-specifier ()

+  (.or (.string= "desc")

+       (.string= "asc")))

+

+(defun .order-list (&optional (separator #\,))

+  (.map 'list (.let* ((name (.name))

+                      (order (.optional

+                               (.and (.is #'whitespacep)

+                                     (.order-specifier))))

+                      (_ (.optional (.char= separator))))

+                (.identity (cons name

+                                 (or order "asc"))))))

+

+(defun .name-list (&optional (separator #\,))

+  (.map 'list (.let* ((name (.map 'string

+                                  (.is (.or #'alpha-char-p

+                                            #'digit-char-p))))

+                      (_ (.optional (.char= separator))))

+                (.identity name))))

+

+(defun .select-clause ()

+  (.let* ((_ (.string= "select"))

+          (_ (.is #'whitespacep))

+          (names (.name-list)))

+    (.identity (vector :order-clause names))))

+

+(defun .where-clause ()

+  (.let* ((_ (.string= "where"))

+          (_ (.is #'whitespacep))

+          (names (.name-list)))

+    (.identity (vector :order-clause names))))

+

+(defun .order-clause ()

+  (.let* ((_ (.string= "order by"))

+          (_ (.is #'whitespacep))

+          (names (.order-list)))

+    (.identity (vector :order-clause names))))

+

+(defun .select-statement ()

+  (.let* ((_ (.string= "where"))

+          (_ (.is #'whitespacep))

+          (names (.name-list)))

+    (.identity (vector :order-clause names))))

+

@@ -35,7 +35,8 @@

 (defpackage #:timesheet.cli

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

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

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

+        #:plambda)

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

 (in-package #:timesheet)

@@ -1,41 +1,12 @@

 (in-package #:timesheet.cli)

 (defparameter *interactive* nil)

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

-

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

-

-(define-message version-message (version)

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

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

 (defun unroll-date (date-obj)

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

     (list day month year)))

-(defun show-version ()

-  (version-message t *version*))

-

 (defun split-time (time)

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

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

@@ -120,7 +91,7 @@

   (flet ((parse-string (string)

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

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

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

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

@@ -143,17 +114,32 @@

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

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

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

-           (when client

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

-           (when reverse

-             (setf results (nreverse results)))

-           results)

-         (get-logs (files)

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

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

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

@@ -166,6 +152,52 @@

                 (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

@@ -174,6 +206,12 @@

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

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

                #:local-time-duration

                #:lquery

                #:ningle

+               #:positional-lambda

                #:serapeum

                #:should-test

                #:smug

@@ -30,6 +31,7 @@

                (:file "parser")

                (:file "mvc")

                (:file "main-classes")  

+               (:file "freshbooks")  

                (:file "timesheet")))