git.fiddlerwoaroof.com
Raw Blame History
#|

(in-package :tempores.mvc)

(defclass model () ())

(defclass view () ())

(defclass controller () ())

(defclass event () ())

(defgeneric operate (controller model event))
(defgeneric model-changed (model receiver))

(defclass client (model)
  ((name :initarg :name)
   (projects :initarg :projects :initform nil)))

(defun make-client (name)
  (make-instance 'client :name name))

(defun normalize-name (name)
  (string-capitalize name))

(defparameter *clients* nil)
(defun make-or-retrieve-client (name)
  (let ((name (normalize-name name)))
    (cdr (or (assoc name *clients* :test #'string=)
             (car (push (cons name (make-client name)) *clients*))))))

(defclass project-description (model)
  ((client :initarg :client :type 'client)
   (note :initarg :note :initform "")))

(defun make-project-description (client-name note)
  (make-instance 'project-description
                 :client (make-or-retrieve-client client-name)
                 :note note))

(defclass generic-log (model)
  ((entries :initarg :entries :initform nil)))

(defgeneric most-recent-entry (container)
  (:method ((container log-entry))
   (with-slots (entries) container
     (car entries))))

(defclass generic-log-entry (model) ())

(defun %add-entry (container entry)
  (push entry (slot-value container 'entries)))

(defgeneric add-entry (log entry))

(defclass time-log (generic-log)
  ((date :initarg :date :initform (local-time:today))))

(defun make-time-log (&optional date)
  (make-instance 'time-log :date (or date (local-time:today))))

(defclass time-span (model)
  ((start :initarg :start :initform (local-time:now))
   (end :initarg :end)))

(defclass time-log-entry (generic-log)
  ((description :initarg :description :type 'project-description)))

(defmethod add-entry ((time-log-entry time-log-entry) (entry time-span))
  (%add-entry time-log-entry entry))

(defmethod add-entry ((time-log time-log) (entry time-log-entry))
  (%add-entry time-log entry))

(defclass work-log (generic-log)
  ((title :initarg :title :initform "")
   (user :initarg :user :initform "")))

(defmethod add-entry ((work-log work-log) (entry time-log))
  (%add-entry work-log entry))

(defun make-work-log (title user)
  (make-instance 'work-log :title title :user user))


;; VIEW

(defgeneric display (model view output))

(defclass log-view (view) ())

(defmethod display ((model work-log) (view log-view) (output stream))
  (let ((spinneret:*html* output))
    (with-slots (title user entries) model
      (spinneret:with-html
        (:html
          (:head
            (:title (format nil "~a: ~a" user title)))
          (:body
            (:h1 title)
            (:ul.work-log
              (loop for time-log in entries
                    do (with-slots (date entries) time-log
                         (spinneret:with-html
                           (:li
                             (:div.date date)
                             (:ul.time-entries
                               (:li.time-span
                                 (loop for time-entry in entries
                                       do (with-slots (description entries) time-entry
                                            (spinneret:with-html
                                              (:div.description
                                                (loop for time-entry in entries
                                                      do (with-slots (start end) time-entry
                                                           (:div.timespan
                                                             (:span.start (format nil "~a" start))
                                                             (when end
                                                               (:span.end (format nil "~a" end))))))
                                                (with-slots (client note) description
                                                  (spinneret:with-html
                                                    (:span.name (with-slots (name) client
                                                                  (format nil "~a:" name)))
                                                    (:span.note note))))))))))))))))))))

(defmethod display (model view (output (eql nil)))
  (with-output-to-string (s)
    (display model view s)))
|#