;;;;
;;;; Quickit - a *very* minimal reddit clone, written in one hour by Bill Moorier.
;;;;

(in-package :quickit)

(defun parse-form-slots (s)
  "Parse slots from a url-part of the form name1=value1&name2=value2..."
  (if (or (null s) (equal s ""))
      nil
      (let* ((index0 (if (char= (aref s 0) #\?) 1 0))
             (index1 (position #\= s))
             (index2 (position #\& s)))
        (if index1
            (cons (list (subseq s index0 index1)
                        (urlstring-unescape (subseq s (1+ index1) index2)))
                  (and index2
                       (parse-form-slots (subseq s (1+ index2)))))
            nil))))

(defvar *demo-url*
  (make-url :scheme "http" :host "abstractnonsense.org" :port 8000))

(defvar *listener*
  (make-instance 'serve-event-http-listener
                 :port (url-port *demo-url*)))

(defvar articles nil)

(defvar next-id 0)

(defclass article ()
  ((description
    :initarg :description
    :initform ""
    :reader article-description)
   (url
    :initarg :url
    :initform (error "Must supply a URL")
    :reader article-url)
   (score
    :initarg :score
    :initform 100
    :accessor article-score)
   (id
    :initform (incf next-id)
    :reader article-id)))

(defun make-article (description url score)
  (make-instance 'article :description description :url url :score score))

(defun print-articles ()
  (with-output-to-string (out)
    (dolist (article articles out)
      (format out "<a href=http://abstractnonsense.org:8000/rankdown?id=~A><img border=0 src=down.png></a> <a href=\"~A\">~A</a> (score ~A)<br>"
              (article-id article) (article-url article) (article-description article) (article-score article)))))

(defun first-n-or-less (n sequence)
  (subseq sequence 0 (min n (length sequence))))

(defun normalise-articles ()
  (setf articles (first-n-or-less 25 (sort articles #'> :key #'article-score))))

(defclass main-handler (handler)
  ())

(defun print-main-page (request)
  (request-send-headers request)
  (html-stream
   (request-stream request)
   `(html (head (title "Quickit"))
          (body ((table :width "100%") (tr (td (h1 "Quickit"))
                                           (td "<p class=right><a href=http://abstractnonsense.org:8000/submit>Submit a link</a></p>")))
                (p ,(print-articles))))))

(defmethod handle-request-response ((handler main-handler) (method (eql :get)) request)
  (print-main-page request))

(defclass submit-handler (handler)
  ())

(defmethod handle-request-response ((handler submit-handler) method request)
  (let* ((url (request-unhandled-part request))
         (params (parse-form-slots url))
         (description (second (assoc "description" params :test #'equalp)))
         (url (second (assoc "url" params :test #'equalp))))
    (cond ((or (null url) (equal url ""))
           (request-send-headers request)
           (html-stream
            (request-stream request)
            `(html (head (title "Submit link"))
                   (body (h1 "Submit a link")
                         ((form :method "get")
                          (p "Description: " ((input :name "description" :type "text" :size "50" :value "")))
                          (p "URL: " ((input :name "url" :type "text" :size "50" :value "")))
                          (p ((input :name "Submit" :value "Submit" :type "submit"))))))))
          (t
           (unless (find url articles :key #'article-url :test #'equalp)
             (push (make-article description url 100) articles)
             (normalise-articles))
           (print-main-page request)))))

(defclass rankdown-handler (handler)
  ())

(defmethod handle-request-response ((handler rankdown-handler) method request)
  (let* ((url (request-unhandled-part request))
         (params (parse-form-slots url))
         (id (second (assoc "id" params :test #'equalp))))
    (let* ((nid (parse-integer id :junk-allowed t))
           (article (find nid articles :key #'article-id)))
      (when article
        (setf (article-score article) (max 0 (1- (article-score article))))
        (normalise-articles))
      (print-main-page request))))

(defun start-quickit ()
  (install-handler (http-listener-handler *listener*)
                   (make-instance 'main-handler)
                   (urlstring (merge-url *demo-url* "/main"))
                   nil)
  (install-handler (http-listener-handler *listener*)
                   (make-instance 'submit-handler)
                   (urlstring (merge-url *demo-url* "/submit"))
                   nil)
  (install-handler (http-listener-handler *listener*)
                   (make-instance 'rankdown-handler)
                   (urlstring (merge-url *demo-url* "/rankdown"))
                   nil)
  (install-handler (http-listener-handler *listener*)
                   (make-instance 'static-file-handler :pathname ".")
                   (urlstring *demo-url*) nil)
  (start-listening *listener*))

(defun stop-quickit ()
  (stop-listening *listener*)
  (setf articles nil))