git.fiddlerwoaroof.com
links.lisp
0760be3e
 (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")))