git.fiddlerwoaroof.com
Raw Blame History
(in-package :inangulis.links)

(defparameter *submissions* nil)

(defclass submission ()
  ((headline  :initarg :headline  :col-type text :initform ""  :accessor s-headline)
   (url       :initarg :url       :col-type text :initform ""  :accessor s-url)
   (date      :initarg :date      :col-type timestamptz :initform "" :accessor s-date)
   (submitter :initarg :submitter :col-type (or s-sql:db-null integer) :accessor s-submitter)
   (curator   :initarg :curator   :col-type (or s-sql:db-null integer) :accessor s-curator)
   (approved  :initarg :approved  :col-type text :initform "" :accessor s-approved))
  (:metaclass pomo:dao-class)
  (:keys headline url))

(pomo:deftable submission
  (pomo:!dao-def) 
  (pomo:!foreign "public.user" "submitter" "id" :on-delete :set-null :on-update :cascade)
  (pomo:!foreign "public.user" "curator" "id" :on-delete :set-null :on-update :cascade))

#|
 |(pomo:with-connection (ubiquitous:value :db)
 |   (pomo:create-table 'submission))
 |#

(defun make-submission (headline url &key (approved ""))
  (alet 'submission
    (make-instance it :headline headline :url url :approved approved :date (current-date-string))))

(defun get-by-key (headline url)
  (car (postmodern:select-dao 'submission (:and (:= 'headline headline) (:= 'url url)))))

(defun alist-submission (alist &key nil-if-exists)
  (let* ((headline (cdr-assoc :headline alist :test #'string-equal))
         (url (cdr-assoc :url alist :test #'string-equal))
         (approved (or (cdr-assoc :approved alist :test #'string-equal) ""))   
         (result (make-submission headline url :approved approved)))
    (with-slots ((headline inangulis.links:headline) (url inangulis.links:url)) result
      (aif (get-by-key headline url)
        (unless nil-if-exists it)
        result))))

(defmethod s-date ((object submission))
  (with-slots (date) object
    (local-time:format-timestring nil date :format local-time:+rfc-1123-format+)))

(defmethod print-object ((obj submission) s)
  (print-unreadable-object (obj s :type t :identity t)
    (with-slots (headline url approved) obj
      (format s "H: ~s U: ~s A: ~s" headline url approved))))

(defmacro with-submissions (&body b)
  `(with-db
     (let ((*submissions* (postmodern:select-dao 'submission t "date desc")))
       ,@b)))

(defun submission-alist (submission)
  (slots-to-pairs submission
                  (headline
                    url
                    date
                    approved)))


(mustache-view root (user . links) #p"static/index.mustache.html"
  :links (mapcar #'submission-alist links)
  :user (when user (inangulis.user:user-alist user)))

(define-controller root (params)
  (with-submissions
    (ningle:with-context-variables (session)
      (handler-case
        (cl-oid-connect.utils:ensure-logged-in
          (cl-oid-connect.utils:redirect-if-necessary session
            (cons (gethash :app-user session)
                  *submissions*)))
        (cl-oid-connect.utils:user-not-logged-in (c) (cons nil *submissions*))))))

(defun submit (params)
  (ningle:with-context-variables (session)
    (let* ((app-user (gethash :app-user session)))
      (awhen (alist-submission params :nil-if-exists t)
        (when app-user
          (setf (s-submitter it)
                (slot-value app-user 'inangulis.user:id)))
        (postmodern:insert-dao it)
        (push it *submissions*))))) 

;; View Controllers
(define-controller murmur (params)
  (sleep 0.01)
  (submit params))

(define-view murmur (model)
  '(302 (:location "/") ("Done"))) 

(defmethod controller :around ((name (eql 'curate)) params &key)
  (cl-oid-connect.utils:require-login
    (call-next-method)))

(define-controller curate (params)
    (let* ((session (ningle:context :session))
           (app-user (gethash :app-user session))
           (approval (string-downcase (str-assoc "approved" params :test #'equalp)))
           (submission (alist-submission params)))
      (setf1 ((s-curator submission) (slot-value app-user 'inangulis.user:id))
             ((s-approved submission) (ccase (elt approval 0)
                                     (#\+ "approved")
                                     (#\- "rejected"))))
      (postmodern:update-dao submission)))

(define-view curate (params)
  '(302 (:location "/") ("Done")))