(cl:defpackage :trail (:use :cl :araneida :webutils :ironclad :colorize)
               (:export :start-trail))
(cl:in-package :trail)

(defvar *url-root* (parse-urlstring "http://trail.unmutual.info/"))
(defvar *password* #(66 11 109 79 204 29 245 128 154 53 68 144 145 40 70 147 54 220 97 69))

(defvar *listener*
  #+single-http-listener single-http-listener:*listener*
  #-single-http-listener
  (make-instance 'serve-event-reverse-proxy-listener
                 :translations
                 `((,(urlstring *url-root*)
                     (:wild-host "/")))
                 :address #(0 0 0 0)
                 :port 8080))

(define-application trail *listener*)

(define-configuration-variable *pathname-root*
    (make-pathname :directory (pathname-directory
                               (load-time-value *load-truename*))))

(defvar *projects* nil)

(define-simple-serialized-class project ()
  ((name :initarg :name :accessor project-name)
   (tasks :initform nil :initarg :tasks :accessor project-tasks)
   (private-p :initform nil :initarg :private-p :accessor project-private-p))
  (:key-slot name)
  (:store *projects*)
  (:store-directory (merge-pathnames
                     (make-pathname :directory '(:relative "projects"))
                     *pathname-root*))
  (:managed-slots tasks))

(defvar *tasks* nil)
(defvar *task-id* 0)

(define-simple-serialized-class task ()
  ((id :initarg :id :accessor task-id)
   (project :initarg :project :accessor task-project)
   (open-p :initarg :open-p :accessor task-open-p)
   (title :initarg :title :accessor task-title)
   (description :initarg :description :accessor task-description)
   (time :initarg :time :accessor task-time)
   (estimate :initarg :estimate :accessor task-estimate)
   (commits :initarg :commits :initform nil :accessor task-commits))
  (:key-slot id)
  (:store *tasks*)
  (:store-directory (merge-pathnames
                     (make-pathname :directory '(:relative "tasks"))
                     *pathname-root*)))

(defmethod register-key (key (class (eql 'task)))
  (setf *task-id* (max *task-id* key)))

(define-object-relations task
  (task-project project-tasks :type :one-to-many))

(defclass login-mixin () ())
(defclass authentication-mixin () ())

(define-handler-hierarchy (:application trail)
    (*url-root*
     ("" (main-handler login-mixin))
     ("login" login-handler)
     ("logout" logout-handler)
     ("view-project" (view-project-handler login-mixin) :inexact t)
     ("new-project" (new-project-handler authentication-mixin))
     ("edit-project" (edit-project-handler authentication-mixin) :inexact t)
     ("view-task" (view-task-handler login-mixin) :inexact t)
     ("new-task" (new-task-handler authentication-mixin))
     ("edit-task" (edit-task-handler authentication-mixin) :inexact t)
     ("adjust-task-time" (adjust-task-time-handler authentication-mixin))
     ("adjust-task-estimate" (adjust-task-estimate-handler authentication-mixin))
     ("add-commit" (add-commit-handler authentication-mixin))
     ("set-task-open" (set-task-open-handler authentication-mixin))
     ("view-source" view-source-handler)))

(install-handler (http-listener-handler *listener*)
                 (make-instance 'static-file-handler
                                :pathname (merge-pathnames
                                           (make-pathname :directory '(:relative "static"))
                                           *pathname-root*))
                 (urlstring (merge-url *url-root* "static/")) nil)

(defvar *is-authorized* nil)

(defun main-menu ()
  (with-xml
    (flet ((link (handler text)
             (let ((url (urlstring (handler-url handler))))
               (<li> (<a href=?url> text)))))
      (<ul>
       (link 'main-handler "Main")
       (if *is-authorized*
           (link 'logout-handler "Logout")
           (link 'login-handler "Login"))
       (link 'new-project-handler "New Project")
       (link 'new-task-handler "New Task")))))

(defmethod application-wrap-page ((application trail) request title body &rest extra-headers)
  (apply #'request-send-headers request :expires 0 extra-headers)
  (with-xml-output-to-stream (request-stream request)
    (<html>
     (<head> (<title> title)
             (let ((css-url (urlstring (merge-url *url-root*
                                                  "static/trail.css"))))
               <link rel= "stylesheet" type= "text/css" href=?css-url />))
     (<body> (<div class= "menu"> (main-menu))
             (<div id= "body"> body)
             (<div class= "menu">
                   (<ul> (<li> (let ((url (urlstring (handler-url 'view-source-handler))))
                                 (<a href=?url> "View Trail's Source")))))))))

(define-application-handler :around ((handler login-mixin) t request)
  (if (is-authorized request)
      (let ((*is-authorized* t))
        (call-next-method))
      (call-next-method)))

(define-application-handler :around ((handler authentication-mixin) t request)
  (if (is-authorized request)
      (let ((*is-authorized* t))
        (call-next-method))
      (application-page ("Please login")
        (let ((url (urlstring (handler-url 'login-handler))))
          (<a href=?url> "Login")))))

(define-form login ()
    (password)
  (:semantic-check (if (not (equalp password *password*))
                       (fail-check "Please enter your password correctly." password))))

(define-form-field (login password) password-form-field
  :string-to-value-translator (lambda (string)
                                (coerce
                                 (digest-sequence :ripemd-160
                                                  (map '(vector (unsigned-byte 8))
                                                       #'char-code string))
                                 '(vector t)))
  :value-to-string-translator (constantly ""))

(define-application-handler ((handler login-handler) :get request)
  (application-page ("Login")
    (form-html (login (handler-url 'login-handler)))))

(define-application-handler ((handler login-handler) :post request)
  (expire-authorization-tokens :filter (constantly t))
  (application-process-form (login)
    :success (let ((*is-authorized* t))
               (application-page ("Login" handler request :set-cookie (make-authorization-token))
                 "You've logged in successfully."
                 <p/>
                 (let ((url (urlstring (handler-url 'main-handler))))
                   (<a href=?url> "Home."))))))

(define-application-handler ((handler logout-handler) t request)
  (expire-authorization-tokens :filter (constantly t))
  (application-page ("Logout")
    "You've logged out."))

(define-table-generator format-tasks
  (:id #'task-link #'task-id)
  (:open (lambda (task) (if (task-open-p task) "Yes" "No")))
  (:title #'task-title)
  (:time #'task-time)
  (:estimate #'task-estimate)
  (:commits (lambda (task) (format nil "~{~A~^ ~}" (task-commits task)))))

(define-extended-table-generator format-task
  (:basic
   (:id #'task-link)
   (:title #'task-title)
   (:project #'(lambda (task) (project-link (task-project task)))))
  (:description
   (:description #'task-description))
  (:status
   (:open (lambda (task) (if (task-open-p task) "Yes" "No")))
   (:time (lambda (task) (princ-to-string (task-time task))))
   (:estimate (lambda (task) (princ-to-string (task-estimate task))))
   (:commits (lambda (task) (format nil "~{~A~^ ~}" (task-commits task))))))

(define-form project ()
    ((project :select :edit) (name :create) (private-p :create :edit)))

(define-class-gate-form-field (project project :select) selector-form-field project)
(define-class-gate-form-field (project project :edit) hidden-form-field project)
(define-form-field (project name :create) form-field
  :string-acceptor (lambda (string)
                     (if (zerop (length string))
                         (fail-check "Please enter a project name."))
                     (if (find-instance-by-key string 'project)
                         (fail-check "There already is a project with this name."))))
(define-form-field (project private-p :create :edit) boolean-form-field
  :pretty-name "Is Private?")

(define-form view-project (format-tasks)
    (project only-open)
  (:semantic-check
   (if (and (project-private-p project) (not *is-authorized*))
       (fail-check "This project is private. Log in first."))))

(defun project-link (project &key (text (project-name project)))
  (let ((url (form-get-url (view-project (handler-url 'view-project-handler))
               (project project)
               (only-open t))))
    (with-xml
      (<a href=?url> text))))

(define-class-gate-form-field (view-project project) selector-form-field project)
(define-form-field (view-project only-open) boolean-form-field
  :pretty-name "Show Only Open Tasks?")

(define-form task ()
    ((task :select :hidden-select :edit)
     (project :create)
     (open-p :edit)
     (title :create :edit)
     (description :create :edit)
     (time :edit)
     (estimate :create :edit))
  (:semantic-check
   :select :hidden-select :edit
   (if (and (project-private-p (task-project task)) (not *is-authorized*))
       (fail-check "This project is private. Log in first."))))

(defun task-link (task &key (text (prin1-to-string (task-id task))))
  (let ((url (form-get-url ((task :select) (handler-url 'view-task-handler))
               (task task))))
    (with-xml
      (<a href=?url> text))))

(define-class-gate-form-field (task task :select) form-field task :key-slot-type integer)
(define-class-gate-form-field (task task :hidden-select :edit) hidden-form-field task :key-slot-type integer)
(define-class-gate-form-field (task project :create) selector-form-field project)
(define-form-field (task open-p :edit) boolean-form-field)
(define-form-field (task title :create :edit) form-field :string-acceptor #'nonempty-string-validator)
(define-form-field (task description :create :edit) textarea-form-field)
(define-template-form-field integer-field form-field
  :string-acceptor (lambda (string)
                     (unless (parse-integer string :junk-allowed t)
                       (fail-check "Please enter an integer.")))
  :string-to-value-translator #'parse-integer
  :value-to-string-translator #'prin1-to-string)
(define-form-field (task time :edit) integer-field)
(define-form-field (task estimate :create :edit) integer-field)

(define-form adjust-time ()
    (task delta))
(define-class-gate-form-field (adjust-time task) hidden-form-field task :key-slot-type integer)
(define-form-field (adjust-time delta) integer-field)

(define-form set-open ()
    (task open)
  (:semantic-check
   (unless open
     (when (and (not (zerop (task-estimate task)))
                (zerop (task-time task)))
       (fail-check "Please log at least some time to this task."))
     (unless (task-commits task)
       (fail-check "Please log at least one commit to this task.")))))

(define-class-gate-form-field (set-open task) hidden-form-field task :key-slot-type integer)
(define-form-field (set-open open) boolean-form-field)

(define-form add-commit ()
    (task commit))
(define-class-gate-form-field (add-commit task) hidden-form-field task :key-slot-type integer)
(define-form-field (add-commit commit) integer-field)

(define-application-handler ((handler main-handler) t request)
  (application-page ("Main")
    (<h1> "View a project")
    (form-html (view-project (handler-url 'view-project-handler) :method :get)
      (only-open t))
    (<h1> "View a task")
    (form-html ((task :select) (handler-url 'view-task-handler) :method :get))))

(define-application-handler ((handler view-project-handler) :get request)
  (application-process-form (view-project)
    (application-page ("View Project")
      (format-tasks (if only-open
                        (remove-if-not #'task-open-p (project-tasks project))
                        (project-tasks project)) request)
      <p/>
      (resubmit-form (handler-url 'view-project-handler) :method :get)
      <p/>
      (let ((url (form-get-url ((project :select) (handler-url 'edit-project-handler))
                   (project project))))
        (<a href=?url> "Edit Project")))))

(define-application-handler ((handler new-project-handler) :get request)
  (application-page ("New Project")
    (form-html ((project :create) (handler-url 'new-project-handler)))))

(define-application-handler ((handler new-project-handler) :post request)
  (application-process-form ((project :create))
    (register-instance (make-instance 'project
                                      :name name
                                      :private-p private-p))
    (application-page ("New Project")
      "It's been created.")))

(define-application-handler ((handler edit-project-handler) :get request)
  (application-process-form ((project :select))
    (application-page ("Edit Project")
      (form-html ((project :edit) (handler-url 'edit-project-handler)
                  :gate-fields project)
        (project project)))))

(define-application-handler ((handler edit-project-handler) :post request)
  (application-process-form ((project :edit))
    (serialize-instance (set-slots-from-form-values project))
    (application-page ("Edit Project") "It's been done.")))

(define-application-handler ((handler new-task-handler) :get request)
  (application-page ("New Task")
    (form-html ((task :create) (handler-url 'new-task-handler))
      (estimate 0))))

(define-application-handler ((handler new-task-handler) :post request)
  (application-process-form ((task :create))
    (let ((task (make-instance 'task :id (incf *task-id*)
                               :project project
                               :open-p t
                               :title title
                               :description description
                               :time 0
                               :estimate estimate
                               :commits nil)))
      (register-instance task)
      (application-page ("New Task")
        "The task has been made."
        <p/>
        (task-link task :text "View the task.")
        <p/>
        (project-link project :text "View the project.")))))

(define-application-handler ((handler view-task-handler) :get request)
  (application-process-form ((task :select))
    (application-page ("View Task")
      (format-task task)
      <p/>
      (form-html ((task :hidden-select) (handler-url 'edit-task-handler)
                  :method :get :submit-text "Edit Task")
        (task task))
      <p/>
      (form-html (adjust-time (handler-url 'adjust-task-time-handler)
                              :submit-text "Adjust Time")
        (task task)
        (delta 0))
      <p/>
      (form-html (adjust-time (handler-url 'adjust-task-estimate-handler)
                              :submit-text "Adjust Estimate")
        (task task)
        (delta 0))
      <p/>
      (form-html (set-open (handler-url 'set-task-open-handler)
                           :submit-text (if (task-open-p task)
                                            "Close Task"
                                            "Open Task"))
        (task task)
        (open (not (task-open-p task))))
      <p/>
      (form-html (add-commit (handler-url 'add-commit-handler)
                             :submit-text "Add Commit")
        (task task)))))

(define-application-handler ((handler edit-task-handler) :get request)
  (application-process-form ((task :select))
    (application-page ("Edit Task")
      (form-html ((task :edit)
                  (handler-url 'edit-task-handler)
                  :gate-fields task)
        (task task)))))

(define-application-handler ((handler edit-task-handler) :post request)
  (application-process-form ((task :edit))
    (serialize-instance (set-slots-from-form-values task))
    (application-page ("Edit Task")
      "It's been done."
      <p/>
      (task-link task :text "Go back to the task page."))))

(define-application-handler ((handler adjust-task-time-handler) :post request)
  (application-process-form (adjust-time)
    (incf (task-time task) delta)
    (serialize-instance task)
    (application-page ("Adjust Task Time")
      "It's been done."
      <p/>
      (task-link task :text "Go back to the task page."))))

(define-application-handler ((handler adjust-task-estimate-handler) :post request)
  (application-process-form (adjust-time)
    (incf (task-estimate task) delta)
    (serialize-instance task)
    (application-page ("Adjust Task Estimate")
      "It's been done."
      <p/>
      (task-link task :text "Go back to the task page."))))

(define-application-handler ((handler set-task-open-handler) :post request)
  (application-process-form (set-open)
    (setf (task-open-p task) open)
    (serialize-instance task)
    (application-page ("Set Open")
      "It's been done."
      <p/>
      (task-link task :text "Go back to the task page."))))

(define-application-handler ((handler add-commit-handler) :post request)
  (application-process-form (add-commit)
    (push commit (task-commits task))
    (serialize-instance task)
    (application-page ("Add Commit")
      "It's been done."
      <p/>
      (task-link task :text "Go back to the task page."))))

(defparameter *memoized-time* 0)
(defvar *memoized*)

(defmethod handle-request-response ((handler view-source-handler) (method (eql :get)) request)
  (let ((pathname '#.*compile-file-truename*))
    (when (> (file-write-date pathname) *memoized-time*)
      (setf *memoized-time* (get-universal-time))
      (setf *memoized*
            (with-output-to-string (s nil :element-type 'base-char)
              (colorize-file-to-stream :common-lisp pathname s)))))
  (request-send-headers request :expires 0)
  (write-string *memoized* (request-stream request))
  t)

(defmethod start-application ((application trail))
  #-single-http-listener (start-listening *listener*)
  (load-store-for-class 'project)
  (load-store-for-class 'task))