action-item.lisp 8.92 KB
;;; pr0nage :: PR0ject maNAGEment
;;; Copyright (C) 2016 Aaron E Krohn
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

(in-package :pr0nage)

(defun action-items-context-menu (status)
;  (print status)
;  (print 'foo)
  (with-html-output-to-string (*standard-output* nil :indent t)

      (:ul
        (:li (:a :href "/objective/new" "New Objective"))
        (if (eq status :active)
          (htm (:li (:strong "Active")))
          (htm (:li (:a :href "/objectives/active" "Active"))))
        (if (eq status :inactive)
          (htm (:li (:strong "Inactive")))
          (htm (:li (:a :href "/objectives/inactive" "Inactive"))))
        (if (eq status :archived)
          (htm (:li (:strong "Archived")))
          (htm (:li (:a :href "/objectives/archived" "Archived"))))
        (if (eq status :all)
          (htm (:li (:strong "All")))
          (htm (:li (:a :href "/objectives/all" "All"))))
        (if (eq status :custom)
          (htm (:li (:strong "Filtered")))))))

(defun action-items-list-nested-text-view (the-list &optional (root 0) (depth 0))
  (let ((this-list '())
        (the-list-new '()))

    (dolist (item the-list)
      (if (eq root (parent-id item))
        (push item this-list)
        (push item the-list-new)))

    ;; This would be obsolete if I could get the query's ORDER BY correct
    (setf this-list (sort this-list #'< :key 'priority))

    (with-html-output-to-string (*standard-output* nil :indent t)
      (htm
        (dolist (item this-list)
          (fmt "~v@{~A~:*~}~A~A. ~A~&" depth "  " (priority item) (name item))
          (fmt "~A" 
            (action-items-list-nested-text-view 
              the-list-new 
              (id item)
              (1+ depth))))))))

(defun action-items-list-text-view (item-list)
  (standard-page
    (:title "Activity summary")
    (:pre
      (fmt "~A" (action-items-list-nested-text-view item-list)))))

(defun action-items-list-nested-view (the-list status-list &optional (root 0))
  (let ((this-list '())
        (the-list-new '())
        (pup-val)
        (pdown-val))

    (dolist (item the-list)
      (if (eq root (parent-id item))
        (push item this-list)
        (push item the-list-new)))

    ;; This would be obsolete if I could get the query's ORDER BY correct
    (setf this-list (sort this-list #'< :key 'priority))

    (with-html-output-to-string (*standard-output* nil :indent t)
      (htm (:ol
        (dolist (item this-list)

          (setf pup-val (1+ (priority item)))
          (setf pdown-val (1- (priority item)))

          (htm
            (:li :value (format nil "~A" (priority item))

              (if (> pdown-val 0)
                (htm (:a :href
                    (format nil
                      "/objective/~A/prioritize/~A" (id item) pdown-val)
                  "&#x21e7;")(esc " ")))

              (if (<= pup-val (get-max-priority (parent-id item)))
                (htm (:a :href
                    (format nil
                      "/objective/~A/prioritize/~a" (id item) pup-val)
                  "&#x21e9;")(esc " ")))

              (fmt "~A" (name item))

              (:a :href (format nil "/objective/~A/view" (id item)) "View")(esc " ")
              (:a :href (format nil "/objective/~A/edit" (id item)) "&#x270e;")(esc " ")
              (:a :href (format nil "/objective/new/~A"  (id item)) "&#x2795;")
              (fmt "~A"
                (status-action-links-view
                  (id item)
                  (status-id item)
                  status-list))
              (fmt "~A" 
                (action-items-list-nested-view 
                  the-list-new 
                  status-list 
                  (id item)))))))))))

(defun action-items-list-view (title status h3 item-list status-list)
"Create our main projects page"
  (standard-page
    (:title title)
    (:div (fmt "~A" (action-items-context-menu status)))
    (:h3 (fmt "~A" h3))
    (if (zerop (length item-list))
      (htm (:p "No objectives found"))
      (htm (:div :id "objectives-table"
        (fmt "~A" (action-items-list-nested-view item-list status-list)))))))

(defun action-item-view-view (item-id 
                              item-name 
                              item-priority 
                              parent-id 
                              details
                              parent-name
                              child-list
                              status-list
                              status-text)

  "Define our handler for viewing projects"
  (standard-page
    (:title (fmt "View Objective :: ~A" item-name))
    (action-items-context-menu :active)
    (:h3 (fmt "Objective :: ~A" item-name) (:a :href (format nil "/objective/~A/edit" item-id) "&#x270e;"))
    (:table
      (:tr (:th "Name")     (:td (fmt "~A" item-name)))
      (:tr (:th "Priority") (:td (fmt "~A" item-priority)))
      (:tr (:th "ID")       (:td (fmt "~A" item-id)))
      (:tr (:th "Status")   (:td (fmt "~A" status-text)))
      (:tr (:th "Parent")   
        (:td
          (if (zerop parent-id) 
            "None" 
            (htm (:a :href (format nil "/objective/~A/view" parent-id) (fmt "~A" parent-name))))))
      (:tr (:th "Details")  (:td (fmt "~A" details))))

    (:h4 "Child Objectives" (htm (:a :href (format nil "/objective/new/~A" item-id) "&#x2795;")))

    (if (eq nil child-list)
      (htm (:p "No child objectives found"))
      (htm (:div :id "child-objectives" (fmt "~A" (action-items-list-nested-view child-list status-list item-id)))))))

(defun action-item-update-view (item-id item-name item-priority parent-id status-id details item-list status-type-list)
  "Objective edit form"
  (standard-page
    (:title (fmt "Edit Objective :: ~A" item-name))
    (:h3 (fmt "Edit Objective :: ~A" item-id))
    (:form :method "post" :action (format nil  "/objective/~A/save" item-id)
      (:input :type "hidden" :name "item-id" :value item-id)
      (:table
        (:tr
          (:th "Name")
          (:td (:input :type "text" :name "item-name" :value
            (format nil "~A" item-name))))
        (:tr
          (:th "Priority")
          (:td (:input :type "text" :name "item-pri" :value
            (format nil "~A" item-priority))))
        (:tr
          (:th "Status")
          (:td (fmt "~A" (action-item-status-types-select-menu-view "item-status" status-type-list status-id))))
        (:tr
          (:th "Parent")
          (:td (fmt "~A" (action-items-select-menu-view "parent-id" item-list parent-id))))
        (:tr
          (:th "Details")
          (:td (:textarea :rows 5 :cols 30 :name "item-details"(str (format nil "~A" details)))))
        (:tr
          (:th "Save")
          (:td (:input :type "submit" :value "Update")))))))

(defun action-items-select-menu-view (input-name item-list def-val)
  (let ((selected))
    (with-html-output-to-string (*standard-output* nil :indent t :prologue nil)
      (:select :name input-name
        (:option :value 0 " - None - ")
        (dolist (item-obj item-list)
          (if (equal def-val (id item-obj))
            (setf selected t)
            (setf selected nil))
          (htm 
            (:option
             :selected selected
             :value (format nil "~A" (id item-obj))
             (fmt "~A" (name item-obj)))))))))

(defun action-item-create-view (item-list c-item-id)
  "New objective page at /objective/new"
  (standard-page
    (:title "New Objective")
    (:h3 "New Objective")
    (:form :action "/objective/add" :method "post" :id "addform"
      (:table
        (:tr
          (:th "Name")
          (:td (:input :type "text" :name "obj-name" :class "txt")))
        (:tr
          (:th "Parent")
          (:td (fmt "~A" (action-items-select-menu-view "parent-id" item-list c-item-id))))
        (:tr
          (:th "Target Date")
          (:td (:input :type "text" :name "target-date")))
        (:tr
          (:th "Time Format")
          (:td (:a
                :href
                "http://www.postgresql.org/docs/9.1/static/datatype-datetime.html#DATATYPE-DATETIME-DATE-TABLE"
                "PostgreSQL Date/Time")))
        (:tr
          (:th "e.g.")
          (:td (:em "1999-01-08 16:05-08") " or " (:em "Jan-08-1999 04:05 PM PST")))
        (:tr
          (:th "Details")
          (:td (:textarea :cols 30 :rows 4 :name "obj-details")))
        (:tr
          (:td :colspan 2 (:input :type "submit" :value "Save" :class "btn")))))))