@@ -23,6 +23,7 @@

   :serial t

   :components ((:file "package")

                (:file "tables")

+               (:file "web")

                (:file "inangulis")))

 ;; vim: set ft=lisp:

@@ -14,10 +14,6 @@

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

@@ -32,7 +28,9 @@

    (moderator :initarg :moderator :initform nil)))

 (defun user-alist (user)

-  (with-slots (email name moderator) user

+  (with-slots ((email inangulis.tables::email)

+               (name inangulis.tables::name)

+               (moderator inangulis.tables::moderator)) user

     `(("name" . ,name)

       ("email" . ,email)

       ("moderator" . ,moderator))))

@@ -71,6 +69,9 @@

   (remove-if (lambda (x) (not (equal x "approved"))) feeds :key #'s-approved))

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

+(defmethod lack.component:call :before ((component (eql *app*)) env)

+  (awhen (gethash "x-remote-ip" (lack.request:request-headers ningle.context:*request*))

+    (setf (lack.request:request-remote-addr ningle:*request*) it)))

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

   `(defun ,name (,@args)

@@ -84,12 +85,6 @@

      (declare (ignorable ,@args))

      ,@body))

-(defun render-mustache (fn data)

-  (with-open-file (s (truename fn))

-    (let ((template (make-string (file-length s))))

-      (read-sequence template s)

-      (mustache:render* template data))))

-

 (defmacro with-db (&body b)

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

      ,@b))

@@ -100,28 +95,12 @@

        ,@b)))

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

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

-  (with-db

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

-      (postmodern:insert-dao it)

-      (push it *submissions*))))

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

@@ -130,27 +109,37 @@

       (ironclad:update-digest hasher (babel:string-to-octets alimenta:link))

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

+(defmethod run-route :around (name params &rest r)

+  (declare (ignore r))

+  (with-db

+    (pomo:with-transaction ()

+      (call-next-method))))

+

 ;; View Controllers

-(i-defun murmur (params)

+(define-controller 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)))))))

+  (submit params))

+

+(define-view murmur (model)

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

+  

+(define-controller curate (params)

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

+

+(define-view curate (params)

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

-(i-defun login-page (params)

-  `(200 ()

+(define-view login-page (model)

+  `(200

+    ()

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

         (:html

           (:head

@@ -161,15 +150,17 @@

             (:div :class "login-buttons"

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

-(i-defun logout (params)

+(define-controller logout (params)

   (ningle:with-context-variables (session)

-    (setf (gethash :userinfo session) nil)

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

+    (setf (gethash :userinfo session) nil)))

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

+(define-view logout (model)

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

+

+(defmethod controller ((name (eql '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

+    (prog1 feed

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

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

                            (:desc 'date))

@@ -178,29 +169,88 @@

                                     :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") #'logout)) 

-

+                                    :content "")))))

+

+(defparameter *tmp* nil)

+

+(define-view get-feed (feed)

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

+

+(mustache-view root (user . links) #p"static/index.mustache.html"

+  :links (mapcar #'submission-alist links)

+  :user (when user (user-alist user)))

+

+(define-controller root (params)

+  (setf *tmp* ningle.context:*request*)

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

+

+(defmethod controller :around ((name (eql 'headlines)) params &key (moderated t moderated-p))

+  (unless moderated-p

+    (awhen (str-assoc "moderated" params :test #'string-equal)

+           (setf moderated (and (> (length it) 0) (char= #\t (elt it 0)))

+                 moderated-p t)))

+  (if moderated-p

+    (call-next-method name params :moderated moderated)  

+    (call-next-method)))

+

+(defmethod controller ((name (eql 'headlines)) params &key (moderated t moderated-p))

+  (let (result)

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

+      (let* ((app-user (gethash :app-user session))

+             (moderator-p (and app-user (slot-value app-user 'inangulis.tables::moderator))))

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

+                             (:raw (cond 

+                                     ((and moderator-p (not moderated-p)) "'t'")

+                                     (moderated (pomo:sql (:= 'approved "approved")))

+                                     (t "'t'")))

+                             (:desc 'date))

+          (push submission result))))

+    result))

+

+(define-view headlines (columns) ;#p"static/headlines.mustache.html"

+  (let ((sub-len (length columns))

+        (columns (mapcar #'submission-alist columns)))

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

+                     `((:columns . (((:rows .  ,(subseq columns 0 (floor sub-len 3))))

+                                    ((:rows .  ,(subseq columns (floor sub-len 3) (* 2 (floor sub-len 3)) )))

+                                    ((:rows .  ,(subseq columns (* 2 (floor sub-len 3)) sub-len)))))))))

+

+(defroutes *app*

+  (("/") (as-route 'root))

+  (("/curo" :method :POST) (as-route 'curate)) 

+  (("/feed") (as-route 'get-feed :moderated t))

+  (("/firehose") (as-route 'get-feed))

+  (("/headlines") (as-route 'headlines)) 

+  (("/login") (as-route 'login-page))

+  (("/logout") (as-route 'logout)) 

+  (("/murmuro" :method :POST) (as-route 'murmur)))

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

   (declare (ignore args))

   (let ((id (cdr (assoc :id userinfo))))

-    (unless (gethash id *users*)

-      (setf (gethash id *users*)

-            (alet (make-instance 'user)

-              (with-slots (uid name email) it

-                (prog1 it

-                  (setf uid id

-                        name (cdr (assoc :name userinfo))

-                        email (cdr (assoc :email userinfo))))))))

-    (gethash id *users*)))

+    (with-db

+      (aif (car (postmodern:select-dao 'inangulis.tables::user (:= 'uid id)))

+        it

+        (alet (make-instance 'inangulis.tables::user)

+          (with-slots ((uid inangulis.tables::uid)

+                       (name inangulis.tables::name)

+                       (email inangulis.tables::email)) it

+            (prog1 it

+              (setf uid id

+                    name (cdr (assoc :name userinfo))

+                    email (cdr (assoc :email userinfo)))

+              (pomo:with-transaction ()

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

+

+

+

 (let ((handler nil))

   (ubiquitous:restore :inangulis)

@@ -222,7 +272,7 @@

                          :backtrace

                          *app*

                          )

-                       :debug (ubiquitous:defaulted-value t 'debug))

+                      :debug (ubiquitous:defaulted-value t 'debug))

               :port 9090

               :server server)

             handler)))

@@ -4,6 +4,15 @@

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

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

+(defpackage #:inangulis.web

+  (:use #:cl)

+  (:export #:defroutes #:as-route #:define-controller #:define-view

+           #:controller #:view #:run-route #:mustache-view #:render-mustache

+           #:setf1))

+

 (defpackage #:inangulis

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

+  (:use #:cl #:anaphora #:inangulis.tables #:inangulis.web))

+

+(defpackage #:inangulis-user

+  (:use #:cl #:inangulis.tables #:inangulis.web #:inangulis))

new file mode 100644

@@ -0,0 +1,110 @@

+<!DOCTYPE html>

+<html lang="en">

+  <head prefix="og: http://ogp.me/ns# fb: http://ogp.me/ns/fb# join-marrow: http://ogp.me/ns/fb/join-marrow#">

+    <base href="http://planet.joinmarrow.com" />

+    <meta property="og:type" content="join-marrow:headlines" />

+    <meta property="og:title" content="Current Headlines" />

+    <meta property="og:site_name" content="Catholic News" />

+    <meta property="og:url" content="http://planet.joinmarrow.com/headlines" />

+    <meta property="og:image" content="http://planet.joinmarrow.com/planet.joinmarrow.png" />

+    <meta property="og:image:width"  content="512" />

+    <meta property="og:image:height" content="512" />

+    <meta property="og:description" content="Headlines from a collection of Catholic blogs. Visit us to take the pulse of the Catholic internet" />

+    <meta property="fb:app_id" content="897925460261572" />

+    <base target="_blank" />

+    <meta http-equiv="refresh" content="900"> <!-- refresh every 15 minutes -->

+

+    <link rel="apple-touch-icon" sizes="57x57" href="/apple-touch-icon-57x57.png">

+    <link rel="apple-touch-icon" sizes="60x60" href="/apple-touch-icon-60x60.png">

+    <link rel="apple-touch-icon" sizes="72x72" href="/apple-touch-icon-72x72.png">

+    <link rel="apple-touch-icon" sizes="76x76" href="/apple-touch-icon-76x76.png">

+    <link rel="apple-touch-icon" sizes="114x114" href="/apple-touch-icon-114x114.png">

+    <link rel="apple-touch-icon" sizes="120x120" href="/apple-touch-icon-120x120.png">

+    <link rel="apple-touch-icon" sizes="144x144" href="/apple-touch-icon-144x144.png">

+    <link rel="apple-touch-icon" sizes="152x152" href="/apple-touch-icon-152x152.png">

+    <link rel="apple-touch-icon" sizes="180x180" href="/apple-touch-icon-180x180.png">

+    <link rel="icon" type="image/png" href="/favicon-32x32.png" sizes="32x32">

+    <link rel="icon" type="image/png" href="/favicon-194x194.png" sizes="194x194">

+    <link rel="icon" type="image/png" href="/favicon-96x96.png" sizes="96x96">

+    <link rel="icon" type="image/png" href="/android-chrome-192x192.png" sizes="192x192">

+    <link rel="icon" type="image/png" href="/favicon-16x16.png" sizes="16x16">

+    <link rel="manifest" href="/manifest.json">

+    <link rel="mask-icon" href="/safari-pinned-tab.svg" color="#5bbad5">

+    <meta name="msapplication-TileColor" content="#888888">

+    <meta name="msapplication-TileImage" content="/mstile-144x144.png">

+    <meta name="theme-color" content="#ffffff">

+

+    <meta charset="UTF-8">

+    <meta name="viewport" content="width=device-width, initial-scale=1">

+

+    <title>Catholic Feeds - Headlines</title>

+    <link rel="stylesheet" href="headline-style.css">

+    <link rel="stylesheet" href="light.css">

+    <!-- Piwik -->

+    <script type="text/javascript">

+      var _paq = _paq || [];

+      _paq.push(['trackPageView']);

+      _paq.push(['enableLinkTracking']);

+      (function() {

+       var u="//piwik.elangley.org/";

+       _paq.push(['setTrackerUrl', u+'piwik.php']);

+       _paq.push(['setSiteId', 1]);

+       var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0];

+       g.type='text/javascript'; g.async=true; g.defer=true; g.src=u+'piwik.js'; s.parentNode.insertBefore(g,s);

+       })();

+

+function colorflip() {

+  var lightEl = document.querySelector('link[href^=light]');

+  var darkEl = document.querySelector('link[href^=dark]');

+

+  if (lightEl !== null) {

+    lightEl.href = "dark.css"

+  } else {

+    darkEl.href = "light.css"

+  }

+};

+

+</script>

+<noscript><p><img src="//piwik.elangley.org/piwik.php?idsite=1" style="border:0;" alt="" /></p></noscript>

+<!-- End Piwik Code -->

+

+   </head>

+   <body>

+     <script type="text/javascript">

+       //do work

+

+     if (window.location.hash === "#dark") {

+       console.log('hi!');

+       colorflip();

+     }

+

+</script>

+<div id="fb-root"></div>

+<script>(function(d, s, id) {

+  var js, fjs = d.getElementsByTagName(s)[0];

+  if (d.getElementById(id)) return;

+  js = d.createElement(s); js.id = id;

+  js.src = "//connect.facebook.net/en_US/sdk.js#xfbml=1&version=v2.5&appId=897925460261572";

+  fjs.parentNode.insertBefore(js, fjs);

+  }(document, 'script', 'facebook-jssdk'));</script>

+

+<header>

+<button class="flip-button" onclick="colorflip()">&hellip;</button>

+<h1>Headlines</h1>

+</header>

+<main>

+{{#columns}}

+<div class="col">

+  {{#rows}}

+  <article data-date="{{date}}">

+  <a href="{{url}}" rel="nofollow">

+    <h2>{{headline}}</h2>

+    <span class="source">{{url}}</span>

+  </a>

+  </article>

+  {{/rows}}

+</div>

+{{/columns}}

+</main>

+   </body>

+ </html>

new file mode 100644

@@ -0,0 +1,52 @@

+<!DOCTYPE html>

+<html lang="en">

+  <head>

+    <meta charset="UTF-8">

+    <title>In Angulis</title>

+    <!--<link rel="stylesheet" href="/css/baseline.css">-->

+    <link rel="stylesheet" href="/static/css/main.css">

+  </head>

+  <body>

+  <h1>In Angulis</h1>

+  {{#user}}

+  <div class="userinfo">

+    <div class="user">{{name}}</div>

+    <div class="email">{{email}}</div>

+    <div class="mod">{{moderator}}</div>

+    <a id="logout" href="/logout">[Logout]</a>

+    </div>

+    {{/user}}

+    <main id="app">

+    <form action="/murmuro" id="submission" name="submission" method="POST"  v-on:submit="submit">

+      <input type="text" name="headline" placeholder="Headline" v-model="newLink.headline">

+      <input type="text" name="url" placeholder="URL" v-model="newLink.url">

+      <input type="submit" value="Go" title='Murmuro'>

+    </form>

+    </main>

+

+    <script src="/static/js/jquery.js"></script>

+    <script src="/static/js/jquery.formalize.js"></script>

+    <script src="/static/js/vue.js"></script>

+    <script type="text/javascript">

+    new Vue({

+      el: '#app',

+

+      methods: {

+        submit: function(e) {

+          e.preventDefault();

+          this.links.unshift(0,Object.create(this.newLink));

+          this.newLink = {};

+          return false;

+        }

+      },

+

+      data: {

+        newLink: {

+        }

+      }

+    });

+    </script>

+</body>

+       </html>

+

+

@@ -3,6 +3,18 @@

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

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

+(defclass user ()

+  ((id :col-type serial)

+   (uid :initarg :uid :col-type text)

+   (email :initarg :email :col-type text)

+   (name :initarg :name :col-type text)

+   (moderator :initarg :moderator :initform nil :col-type bool))

+  (:metaclass dao-class)

+  (:keys id))

+

+(deftable user

+  (!dao-def))

+

 (defclass submission ()

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

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

@@ -15,6 +27,10 @@

   (!dao-def))

 ;; (ubiquitous:restore :inangulis)

+

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

+;;   (create-table 'user))

+

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

 ;;   (create-table 'submission))

new file mode 100644

@@ -0,0 +1,61 @@

+;; This is a minimal web-framework built on ningle that attempts to decouple

+;; views from controllers and make life more interesting.

+(in-package :inangulis.web)

+

+(defgeneric controller (name params &key))

+(defgeneric view (name model))

+(defgeneric run-route (name params &rest r))

+

+(defmacro setf1 (&body body)

+  "Make setf a bit nicer"

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

+

+(defmacro defroutes (app &body routes)

+  (alexandria:once-only (app)

+    (list* 'setf1

+           (loop for ((target &key method) callback) in routes

+                 collect `((ningle:route ,app ,target :method ,(or method :GET)) ,callback)))))

+

+ 

+(defmacro as-route (name &rest r &key &allow-other-keys)

+  `(lambda (params) (run-route ,name params ,@r)))

+

+

+(defmethod run-route (name params &rest r)

+  (view name (apply #'controller (list* name params r))))

+

+(defmethod controller (name params &key)

+  params)

+

+(defmacro define-controller (name (params &rest r &key &allow-other-keys) &body body)

+  `(defmethod controller ((name (eql ',name)) ,params &key ,@r)

+     ,@body))

+

+(defmacro define-view (name (model) &body body)

+  `(defmethod view ((name (eql ',name)) ,model)

+     ,@body))

+

+(defun render-mustache (fn data)

+  (with-open-file (s (truename fn))

+    (let ((template (make-string (file-length s))))

+      (read-sequence template s)

+      (mustache:render* template data))))

+

+

+(defmacro mustache ((template lambda-list data) &body body)

+  "Template specifies the template to be render, lambda-list is used to destructure data

+   and body transforms the destructured data into an alist for use in the template"

+  (alexandria:once-only (template)

+    `(destructuring-bind ,lambda-list ,data

+       (render-mustache ,template

+                        (list

+                          ,@(loop for (k v) on body by #'cddr

+                                  if (or k v)

+                                  collect `(cons ,k ,v)))))))

+

+(defmacro mustache-view (name lambda-list template &body body)

+  (alexandria:with-gensyms (model)

+    `(define-view ,name (,model)

+       (mustache (,template ,lambda-list ,model)

+         ,@body))))

+