;;;; timesheet.lisp
 
 (in-package #:timesheet)
 

 (ubiquitous:restore 'timesheet)
 

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

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

 (defmethod duration ((obj partial-entry))
   (warn "incomplete entry detected for ~a" (client obj))
   (local-time-duration:duration))
 

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

 (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)
         (unless (string= leftovers "")

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

         parsed))))

 
 (defun unroll-date (date-obj)
   (with-slots (year month day) date-obj
     (list day month year)))
 

 (defun combine-date-time (time-obj day month year)
   (with-slots (second minute hour) time-obj
     (local-time:encode-timestamp 0 second minute hour
                                  day month year)))
 

 (defun calculate-ranges (ranges year month day)

   (flet ((time-mod-unit-keyword (time-mod)
            (make-keyword
              (string-upcase
                (if (string= (slot-value time-mod 'unit) "mins")
                  "minute"
                  "hour")))))

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

           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)

                      '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 ranges = (get-entry-ranges entry)
              append ranges))))

 
 (defparameter +pprint-log-option-spec+

   '((("client" #\c) :type boolean :optional t :documentation "Sort by client")
     (("reverse" #\r) :type boolean :optional t :documentation "Reverse sort")
     (("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: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 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)))))))
 
 (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 ((entries list))
    (mapcar #'print-entries entries))
   (:method ((entry partial-entry))
    (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))))
   (:method ((it complete-entry))
    (format t "~&~4a ~10<~:(~a~)~> ~7,2F hrs ~a~%"
            (date it) (client it) (duration it) (memo it))))

 
 (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 update (calculator entry)
   (:method ((calculator status-calculator) entry)
    (incf (total-hours calculator) (duration entry)))
   (:method ((calculator status-line) entry)
    (incf (duration calculator) (duration entry))))
 
 (defun update-clients (clients-hash-table entry)
   (with-accessors ((client client)) entry
     (update (ensure-gethash client clients-hash-table
                             (make-instance 'status-line :client client)) 
             entry)))
 
 (defun calculate-results (results &optional (rate *rate*))
   (let ((status-calculator
           (make-instance 'status-calculator
                          :rate rate
                          :client-totals (make-hash-table :test 'equalp))))
     (prog1 status-calculator
       (loop for entry in results
             do (update-clients (client-totals status-calculator) entry)
             do (update status-calculator entry)))))
 
 (defgeneric total-line (calc rate)
   (:method ((calc status-calculator) rate)
    (with-accessors ((total-hours total-hours)) calc

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

              total-hours rate (* rate total-hours)))))
 
 (defgeneric calculate-cost (calc time)
   (:method ((calc status-calculator) (status-line status-line))
    (* (rate calc) (duration status-line))))

 
 (defun print-status (results)

   (let* ((status-calculator (calculate-results results)))
     (flet ((print-status-line (status-line)
              (format t "~&~:(~26<~a~>~):~7,2F hours @ ~7,2F $/hr = $~7,2F~%"
                      (client status-line)
                      (duration status-line)
                      (rate status-calculator)
                      (calculate-cost status-calculator status-line))))
       (format t "~&~120,1,0,'-<~>~%")
       (loop with client-totals = (client-totals status-calculator)
             for  client in (sort (hash-table-keys client-totals) #'string-lessp)
             for  status-line = (gethash client client-totals)
             do (print-status-line status-line))
       (format t (total-line status-calculator *rate*)))))

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

 
 (defun pprint-log (args &key client reverse status help)
   (when help
     (show-help)
     (return-from pprint-log))
 

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

     (let ((*default-time-sheet-file* (or (car args) *default-time-sheet-file*))
           (*print-pretty* t))

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