@@ -5,17 +5,22 @@

   :author "socraticum"

   :license "MIT"

   :depends-on (#:alimenta

-               #:cl-oid-connect

-               #:cl-mustache

-               #:parenscript

-               #:alexandria

-               #:anaphora

-               #:ironclad

-               #:postmodern

-               #:ubiquitous

-               #:ningle)

+                #:cl-oid-connect

+                #:cl-mustache

+                #:parenscript

+                #:alexandria

+                #:anaphora

+                #:ironclad

+                #:clack-errors

+                #:postmodern

+                #:local-time

+                #:cl-postgres+localtime

+                #:crane

+                #:ubiquitous

+                #:ningle)

   :serial t

   :components ((:file "package")

+               (:file "tables")

                (:file "inangulis")))

 ;; vim: set ft=lisp:

@@ -1,21 +1,29 @@

 (declaim (optimize (debug 3) (speed 0 ) (safety 3)) )

+

 ;;;; inangulis.lisp

-(ql:quickload :clack-errors)

 (in-package #:inangulis)

 (defparameter *submissions* nil)

 (defparameter *by-distinct* (make-hash-table :test #'equalp))

 (defparameter *users* (make-hash-table :test #'equalp))

+(defparameter *persist* t)

+

+(defmacro cdr-assoc (&whole lis item alist &key key test test-not)

+  `(cdr (assoc ,@(cdr lis))))

+

+(defun str-assoc (param params &key (test #'equal) key)

+  (cdr-assoc param params :test test :key key))

+

+(defmacro setf1 (&body body)

+  "Make setf a bit nicer"

+  (list* 'setf (apply #'append body)))

 ;;; "inangulis" goes here. Hacks and glory await!

 (defun current-date-string ()

   "Returns current date as a string."

-  (multiple-value-bind (sec min hr day mon yr dow dst-p tz)

-    (get-decoded-time)

-    (declare (ignore dow dst-p))

-    (format nil "~4,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d ~2,'0d" yr mon day hr min sec tz)))

-

+  (local-time:format-timestring nil (local-time:now) 

+                                :format local-time:+rfc-1123-format+))

 (defclass user ()

   ((uid :initarg :uid)

@@ -29,25 +37,14 @@

       ("email" . ,email)

       ("moderator" . ,moderator))))

-(defclass submission ()

-  ((headline :initarg :headline :initform ""  :accessor s-headline)

-   (url      :initarg :url      :initform ""  :accessor s-url)

-   (date     :initarg :date     :initform ""  :accessor s-date)

-   (approved :initarg :approved :initform "" :accessor s-approved)))

-

 (defmethod print-object ((obj user) s)

   (print-unreadable-object (obj s :type t :identity t)

     (with-slots (uid email name moderator) obj

       (format s "U: ~s E: ~s N: ~s M: ~s" uid email name moderator))))

-(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))))

-

 (defun make-submission (headline url &key (approved ""))

-  (make-instance 'submission :headline headline :url url :approved approved

-                 :date (current-date-string)))

+  (alet 'inangulis.tables:submission

+    (make-instance it :headline headline :url url :approved approved :date (current-date-string))))

 (defun submission-alist (submission)

   `(("headline". ,(s-headline submission))

@@ -55,19 +52,18 @@

     ("date" . ,(s-url submission))

     ("approved" . ,(s-approved submission))))

-(defun alist-submission (alist &key nil-if-exists (modify t))

-  (let* ((result (make-submission (cdr (assoc :headline alist :test #'string-equal))

-                                  (cdr (assoc :url alist :test #'string-equal))

-                                  :approved (aif (cdr (assoc :approved alist :test #'string-equal)) it "")))

-         (key (cons (s-headline result) (s-url result))))

-    (aif (gethash key *by-distinct*)

-      (progn

-        (when modify

-          (setf (s-url it) (s-url result)

-                (s-headline it) (s-headline result)))

-        (if nil-if-exists nil it))

-      (progn

-        (setf (gethash key *by-distinct*) result)

+(defun get-by-key (headline url)

+  (car (postmodern:select-dao 'inangulis.tables::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.tables:headline) (url inangulis.tables:url)) result

+      (aif (get-by-key headline url)

+        (unless nil-if-exists it)

         result))))

@@ -76,6 +72,13 @@

 (defparameter *app* (make-instance 'ningle:<app>))

+(defmacro i-defun (name (&rest args) &body body)

+  `(defun ,name (,@args)

+     (declare (ignorable ,@(loop for x in args

+                                 if (not (char= (elt (symbol-name x) 0) #\&))

+                                 collect x)))

+     ,@body))

+

 (defmacro i-lambda ((&rest args) &body body)

   `(lambda (,@args)

      (declare (ignorable ,@args))

@@ -87,67 +90,38 @@

       (read-sequence template s)

       (mustache:render* template data))))

+(defmacro with-db (&body b)

+  `(postmodern:with-connection (ubiquitous:value 'db)

+     ,@b))

+

+(defmacro with-submissions (&body b)

+  `(with-db

+     (let ((*submissions* (postmodern:select-dao 'inangulis.tables::submission t "date desc")))

+       ,@b)))

+

+

 (setf (ningle:route *app* "/")

-      (i-lambda (params)

-        (ningle.context:with-context-variables (session)

-          (handler-case

-            (cl-oid-connect.utils:ensure-logged-in

-              (cl-oid-connect.utils:redirect-if-necessary session

-                (render-mustache #p"static/index.mustache.html"

-                                 `((:links . ,(mapcar #'submission-alist *submissions*))

-                                   (:user . ,(user-alist (gethash :app-user session)))))))

-            (cl-oid-connect.utils:user-not-logged-in

-              (c)

-              (render-mustache #p"static/index.mustache.html"

-                               `((:links . ,(mapcar #'submission-alist (get-moderated *submissions*))))))))))

+      (flet ((render-index (&optional user)

+               (render-mustache #p"static/index.mustache.html"

+                                (cons

+                                  `(:links . ,(mapcar #'submission-alist *submissions*))

+                                  (when user

+                                    (list

+                                      `(:user . ,(user-alist user))))))))

+        (i-lambda (params)

+          (with-submissions

+            (ningle.context:with-context-variables (session)

+              (handler-case

+                (cl-oid-connect.utils:ensure-logged-in

+                  (cl-oid-connect.utils:redirect-if-necessary session

+                    (render-index (gethash :app-user session))))

+                (cl-oid-connect.utils:user-not-logged-in (c) (render-index))))))))

 (defun submit (params)

-  (awhen (alist-submission params :nil-if-exists t)

-    ;(format t "~s <<<" it)

-    (push it *submissions*)))

-

-(defun get-by-key (headline url)

-  (gethash (cons headline url) *by-distinct*))

-

-(setf (ningle:route *app* "/murmuro" :method :POST)

-      (i-lambda (params)

-        (sleep 0.01)

-        (submit params)

-        '(302 (:location "/") ("Done"))))

-

-(setf (ningle:route *app* "/curo" :method :POST)

-      (i-lambda (params)

-        (cl-oid-connect.utils:require-login

-          (alet (alist-submission params :modify nil)

-            (let ((approval (string-downcase (cdr (assoc "approved" params :test #'equalp)))))

-              (setf (s-approved it)

-                    (if (equal approval "+") "approved"

-                      (if (equal approval "-") "rejected"))))))

-        '(302 (:location "/") ("Done"))))

-

-(setf (ningle:route *app* "/1" :method :GET)

-      (i-lambda (params)

-        `(200 ()

-          (,(format nil "~a" (/ 1 0))))))

-

-(setf (ningle:route *app* "/login" :method :GET)

-      (i-lambda (params)

-        `(200 ()

-          (,(cl-who:with-html-output-to-string (s)

-              (:html

-                (:head

-                  (:title "Login")

-                  (:link :rel "stylesheet" :href "/static/css/login.css"))

-                (:body

-                  (:h1 "In Angulis")

-                  (:div :class "login-buttons"

-                   (:a :class "facebook" :href "/login/facebook" "Login With Facebook")))))))))

-

-(cl-oid-connect:def-route ("/logout" (params) :app *app*)

-  (declare (ignore params))

-  (ningle:with-context-variables (session)

-    (setf (gethash :userinfo session) nil)

-    '(302 (:location "/"))))

+  (with-db

+    (awhen (alist-submission params :nil-if-exists t)

+      (postmodern:insert-dao it)

+      (push it *submissions*))))

 (defun get-feed-guid (item)

   (with-slots (alimenta:title alimenta:link) item

@@ -156,31 +130,64 @@

       (ironclad:update-digest hasher (ironclad:ascii-string-to-byte-array alimenta:link))

       (ironclad:byte-array-to-hex-string (ironclad:produce-digest hasher)))))

-(setf (ningle:route *app* "/feed" :method :GET)

-      (i-lambda (params)

-        (let ((feed (alimenta::make-feed :title "In Angulis" :link "http://srv2.elangley.org:9090/feed"

-                                         :description "Locus in quo sunt illi qui murmurant in angulis")))

-          (loop for submission in (reverse (get-moderated *submissions*))

-                do (alimenta::add-item-to-feed feed

-                                               :title (s-headline submission)

-                                               :link (s-url submission)

-                                               :date (current-date-string)

-                                               :next-id #'get-feed-guid

-                                               :content ""))

-          `(200 (:content-type "application/rss+xml") (,(plump:serialize (alimenta:generate-xml feed) nil))))))

-

-(setf (ningle:route *app* "/firehose" :method :GET)

-      (i-lambda (params)

-        (let ((feed (alimenta::make-feed :title "In Angulis" :link "http://srv2.elangley.org:9090/feed"

-                                         :description "Locus in quo sunt illi qui murmurant in angulis")))

-          (loop for submission in (reverse *submissions*)

-                do (alimenta::add-item-to-feed feed

-                                               :title (s-headline submission)

-                                               :link (s-url submission)

-                                               :date (current-date-string)

-                                               :next-id #'get-feed-guid

-                                               :content ""))

-          `(200 (:content-type "application/rss+xml") (,(plump:serialize (alimenta:generate-xml feed) nil))))))

+;; View Controllers

+(i-defun murmur (params)

+  (sleep 0.01)

+  (submit params)

+  '(302 (:location "/") ("Done")))

+

+(i-defun curate (params)

+  (with-db

+    (let ((*submissions* (postmodern:select-dao 'inangulis.tables::submission t "date desc")))

+      (cl-oid-connect.utils:require-login

+        (alet (alist-submission params)

+          (let ((approval (string-downcase (str-assoc "approved" params :test #'equalp))))

+            (setf (s-approved it)

+                  (if (equal approval "+") "approved"

+                    (if (equal approval "-") "rejected")))

+            (when *persist*

+              (postmodern:update-dao it)))))))

+  '(302 (:location "/") ("Done")))

+

+(i-defun login-page (params)

+  `(200 ()

+    (,(cl-who:with-html-output-to-string (s)

+        (:html

+          (:head

+            (:title "Login")

+            (:link :rel "stylesheet" :href "/static/css/login.css"))

+          (:body

+            (:h1 "In Angulis")

+            (:div :class "login-buttons"

+             (:a :class "facebook" :href "/login/facebook" "Login With Facebook"))))))))

+

+(i-defun logout (params)

+  (ningle:with-context-variables (session)

+    (setf (gethash :userinfo session) nil)

+    '(302 (:location "/"))))

+

+(i-defun get-feed (params &key moderated)

+  (let ((feed (alimenta::make-feed :title "In Angulis" :link "http://in-angulis.com/feed"

+                                   :description "Locus in quo sunt illi qui murmurant in angulis")))

+    (with-db

+      (pomo:do-select-dao (('inangulis.tables::submission submission)

+                           (:raw (if moderated (pomo:sql (:= 'approved "approved")) "'t'"))

+                           (:desc 'date))

+        (alimenta::add-item-to-feed feed

+                                    :title (s-headline submission)

+                                    :link (s-url submission)

+                                    :date (s-date submission)

+                                    :next-id #'get-feed-guid

+                                    :content "")))

+    `(200 (:content-type "application/rss+xml") (,(plump:serialize (alimenta:generate-xml feed) nil)))))

+

+(setf1 ((ningle:route *app* "/feed" :method :GET) (lambda (params) (get-feed params :moderated t)))

+       ((ningle:route *app* "/firehose" :method :GET) #'get-feed)

+       ((ningle:route *app* "/login" :method :GET) #'login-page)

+       ((ningle:route *app* "/curo" :method :POST) #'curate)

+       ((ningle:route *app* "/murmuro" :method :POST) #'murmur)

+       ((ningle:route *app* "/logout" :method :POST) #'logout)) 

+

 (cl-oid-connect::setup-oid-connect *app* (userinfo &rest args)

   (declare (ignore args))

@@ -1,8 +1,9 @@

 ;;;; package.lisp

-(defpackage #:inangulis

-  (:use #:cl #:anaphora))

-

 (defpackage #:inangulis.tables

+  (:use #:cl #:anaphora #:postmodern)

+  (:export #:submission #:headline #:url #:date #:approved))

+

+(defpackage #:inangulis

   (:use #:cl #:anaphora))

new file mode 100644

@@ -0,0 +1,27 @@

+(in-package :inangulis.tables)

+

+(eval-when (:compile-toplevel :load-toplevel :execute)

+  (local-time:set-local-time-cl-postgres-readers))

+

+(defclass submission ()

+  ((headline :initarg :headline :col-type text :initform ""  :accessor inangulis::s-headline)

+   (url      :initarg :url      :col-type text :initform ""  :accessor inangulis::s-url)

+   (date     :initarg :date     :col-type timestamp-with-timezone :initform "")

+   (approved :initarg :approved :col-type text :initform "" :accessor inangulis::s-approved))

+  (:metaclass dao-class)

+  (:keys headline url))

+

+(deftable submission

+  (!dao-def))

+

+;(with-connection (ubiquitous:value 'db)

+;  (create-table 'submission))

+

+(defmethod inangulis::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))))