(defpackage #:tempores.freshbooks
  (:use #:cl #:anaphora #:alexandria #:serapeum #:fwoar.lisputils
        #:tempores.parser)
  (:import-from #:tempores #:tempores)
  (:export #:tempores))

(in-package :tempores.freshbooks)

(defvar *api-key*)
(defvar *endpoint*)

(defun init ()
  (ubiquitous:restore 'tempores)
  (ubiquitous:value :freshbooks :api-key)
  (ubiquitous:value :freshbooks :endpoint))

(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*)))
    (drakma:http-request *endpoint*
                         :basic-authorization (list *api-key* "X")
                         :method :post
                         :content (with-output-to-string (s)
                                    (format s "~w" xml)))))

(defun parsed-api-call (xml)
  (plump:parse (post-to-endpoint xml)))

(defmacro define-api-call (name (&rest args) method-name &body elements)
  `(defun ,name ,args
     (parsed-api-call (<:request (:method ,method-name) ,@elements))))

(define-api-call create-time-entry (entry-spec) "time_entry.create"
  entry-spec)

(define-api-call list-invoices () "invoice.list")
(define-api-call list-projects () "project.list")
(define-api-call list-tasks () "task.list")
(define-api-call list-payments () "payment.list")
(define-api-call list-clients () "client.list")

(defgeneric slots-for (cls)
  (:method-combination append))

(defmacro define-simple-class (name (&rest supers) &body elements)
  (let ((schema-name (intern
                       (string-join (list name "-SCHEMA"))))
        (schema-supers (loop for super in supers
                             collect (intern
                                       (string-join
                                         (list (symbol-name super)
                                               "-schema"))))))
    `(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)

(define-simple-class project ()
  project_id name description rate bill_method client_id hour_budget
  tasks staff)

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

(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
    (format s "~a (~a): ~a tasks" name project_id (length tasks)))))

(defparameter *task-registry* (make-hash-table :test 'equal))
(defmethod initialize-instance :after ((self task) &key &allow-other-keys)
  (loop for slot in '(task_id name description billable rate)
        for node = (slot-value self slot)
        unless (null node) do (setf (slot-value self slot) (plump:text node))))

(defun register-task (task)
  (with-slots (task_id) task
    (setf (gethash task_id *task-registry*) task)))

(defparameter *project-registry* (make-hash-table :test 'equal))
(defmethod initialize-instance :after ((self project) &key &allow-other-keys)
  (loop for slot in '(project_id name description rate bill_method client_id hour_budget)
        for node = (slot-value self slot)
        unless (null node) do (setf (slot-value self slot) (plump:text node)))

  (with-slots (tasks) self
    (setf tasks
          (loop for task across (lquery:$ (inline tasks)  "> task")
                for task_id = (lquery:$1 (inline task) "task_id" (text))
                for task-obj = (gethash task_id *task-registry*)
                unless task-obj do (setf task-obj (parse-task task))
                collect task-obj))))

(defun register-project (project)
  (with-slots (name) project
    (setf (gethash name *project-registry*) project)))



(defun parse-task (parsed-xml)
  (apply #'make-instance 'task
         (loop for slot in (slots-for (make-instance 'task-schema))
               nconc (let ((slot-name (format nil "> ~(~a~)" slot)))
                       (list (make-keyword slot)
                             (lquery:$ (inline parsed-xml)
                                       slot-name
                                       (node)))))))

(defun parse-project (parsed-xml)
  (apply #'make-instance 'project
         (loop for slot in (slots-for (make-instance 'project-schema))
               nconc (let ((slot-name (format nil "> ~(~a~)" slot)))
                       (list (make-keyword slot)
                             (lquery:$ (inline parsed-xml)
                                       slot-name
                                       (node)))))))

(defun get-project (name)
  (let ((projects (sort (map 'vector
                             (alambda (cons (string-downcase it) it))
                             (hash-table-keys *project-registry*))
                        #'string<
                        :key #'car))
        (name (string-downcase name)))
    (gethash
      (cdr
        (find-if (alambda (string= it name :end1 (length name)))
                 projects
                 :key #'car))
      *project-registry*)))


(defun make-time-entry (project task date hours notes)
  (<:time_entry ()
                (<:project_id ()
                              (parse-integer
                                (slot-value (get-project project)
                                            'project_id)))
                (<:task_id () (parse-integer task))
                (<:date () (identity date))
                (<:hours () (identity hours))
                (<:notes () (identity notes))))

(defun get-task-by-name (name)
  (let ((tasks (mapcar
                 (destructuring-lambda ((id . task))
                   (cons (slot-value task 'name)
                         id))
                 (hash-table-alist *task-registry*))))
    (cdr (assoc name tasks :test #'string-equal))))

(defun tempores-to-entries (tempores-log)
  (let ((task-id (get-task-by-name "General")))
    (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 (tempores.cli::unroll-date date)))
          collect (make-time-entry project task-id fmt-date hours note))))

(defun make-entry-updates ()
  (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))))

(defun get-entry-data ()
  (init)
  (setf *endpoint* (ubiquitous:value :freshbooks :endpoint))
  (setf *api-key* (ubiquitous:value :freshbooks :api-key))

  (let-each (:be *)
    (list-tasks)
    (lquery:$ * "task")
    (map 'list #'parse-task *)
    (mapcar #'register-task *))

  (let-each (:be *)
    (list-projects)
    (lquery:$ * "project")
    (map 'list #'parse-project *)
    (mapcar #'register-project *))

  (make-entry-updates))

(defun post-time-entries-main ()
  (let-each (:be *)
    (get-entry-data)
    (mapcar #'parsed-api-call *)))