@@ -1,4 +1,5 @@

 (ql:quickload :parenscript)

+(ql:quickload :cl-markup)

 (defpackage :angular

   (:use :parenscript :cl)

@@ -20,12 +21,6 @@

 (defmacro+ps scope-var (name value)

   `(setf ($s ,name) ,value))

-(defmacro+ps resource (name url params &body body)

-  `(var ,name

-        ($resource ,url ,(cons 'create params)

-                   ,(cons 'create (loop for (name form) in body

-                                         append (list name (cons 'create form)))))))

-

 (defmacro+ps scope-function (name arguments &body body)

   `(scope-var ,name (lambda ,arguments

                       ,@body)))

@@ -37,18 +32,49 @@

          (lambda ,(loop for x in dependencies

                         collect x)

            ,@body

-           nil)))

+           )))

 ; This is just for slimv's sake

 (defmacro defcontroller (name dependencies &body body)

   (declare (ignore name dependencies body)))

-(defpsmacro def-module (module-name dependencies &body body)

-  `(macrolet ((defcontroller (name dependencies &body body)

+

+(defmacro+ps resource (name url params &body body)

+  `(var ,name

+        ($resource ,url ,(cons 'create params)

+                   ,(cons 'create (loop for (name form) in body

+                                         append (list name (cons 'create form)))))))

+

+

+(defpsmacro defdirective (module-name name dependencies &body body)

+  (let ((dependencies (cons '$scope dependencies)))

+    `(chain ,module-name

+            (directive ,(symbol-to-js-string name)

+                       ,(build-lambda dependencies

+                                      `((create

+                                          ,@body)))))))

+(defpsmacro markup (&body body)

+  `(lisp (cl-markup:markup ,@body)))

+

+(defun def-module-function (module-name block-name function-name)

+  `(,block-name (name dependencies &body body)

+                (let ((dependencies (cons '$scope dependencies)))

+                  `(chain ,',module-name

+                          (,',function-name ,(symbol-to-js-string name)

+                                            ,(build-lambda dependencies body))))))

+

+(defmacro+ps defmodule (module-name dependencies &body body)

+  `(macrolet ((defdirective (name dependencies &body body)

                 (let ((dependencies (cons '$scope dependencies)))

-                  (list 'chain ',module-name `(controller ,(symbol-to-js-string name)

-                                                          ,(build-lambda dependencies body))))))

+                  `(chain ,',module-name

+                          (directive ,(symbol-to-js-string name)

+                                     ,(build-lambda dependencies

+                                                    `((create

+                                                        ,@body)))))))

+

+              ,(def-module-function module-name 'defservice 'service)

+              ,(def-module-function module-name 'defcontroller 'controller))

      (progn (var ,module-name ((@ angular module) ,(symbol-to-js-string module-name) ,dependencies))

             ,@body)))

new file mode 100644

@@ -0,0 +1,54 @@

+(in-package :whitespace)

+(defun base-template-f (&optional demo)

+  (cl-markup:xhtml5

+    (:head

+      (:title "Whitespace")

+      (:script :src "https://code.jquery.com/jquery-2.1.4.min.js" :type "text/javascript" "")

+      (:script :src "https://cdnjs.cloudflare.com/ajax/libs/angular.js/1.4.5/angular.js" :type "text/javascript" "")

+      (:script :src "https://cdnjs.cloudflare.com/ajax/libs/angular.js/1.4.5/angular-resource.js" :type "text/javascript" "")

+      (:script :src "https://cdnjs.cloudflare.com/ajax/libs/angular.js/1.4.5/angular-sanitize.js" :type "text/javascript" "")

+      (:script :src "/static/js/fold.js" :type "text/javascript" "")

+      (:script :src "/static/js/whitespace-angular.js" :type "text/javascript" "")

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

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

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

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

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

+      (:link :rel "stylesheet" :href "/theme/light.css")

+      (:link :rel "icon" :href "/static/images/Whitespace_favicon.png" :type "image/x-icon")

+      (:link :rel "shortcut icon" :href "/static/images/Whitespace_favicon.png" :type "image/x-icon"))

+

+    (:body :ng-app "whitespace" :ng-controller "MainCtrl"

+     (:header

+       (:button :class "flip-button" "…")

+       (:h1 "Whitespace")

+       )

+     (:section :id "content"

+      (:section :id "sidebar"

+       (:ul :class "menu" 

+        (:li :ng-repeat "feed in feeds.result"

+         (:a :ng-click "toggleClosed(feed)" "{{ feed.title }}"))))

+      (:main

+        (cl-markup:raw

+          (unless demo

+            (cl-markup:markup

+              (:form :name "add-form" :id "add-form" :ng-submit "addFeed()"

+               (:input :type "text" :name "url" :class "urltext" :ng-model "addForm.url" :placeholder "http://example.com/feed.rss . . ." "")

+               (:input :type "hidden" :name "api" :value "yes" "")

+               (:button :type "submit" :class "fsub" "+")))))

+        (:img :ng-class "{spinner: true, hide: feeds.result !== undefined}" :src "/static/images/spinner.gif" "")

+        (:div :class "hide" :ng-class "{hide: feeds.result === undefined}"

+         (:section :ng-class "{feed: true, closed: !feed.closed}" :ng-repeat "feed in feeds.result"

+          (:section :class "feed-header" :ng-click "toggleClosed(feed)"

+           (:h2 "{{ feed.title }}")

+           (:h3 "{{ feed.description }}"))

+          (:ul :class "post-list"

+           (:li :ng-class "{link: true, closed: !item.closed}" :ng-repeat "item in feed.items"

+            (:section :class "link-header" :ng-click "toggleClosed(item)"

+             (:h4 "{{item.title}}")

+             (:p :class "link-info"

+              (:a :target "_blank" :ng-href "{{item.link}}" :class "link-url" "{{item.link}}")

+              (:span :class "link-date" "{{item.date}}")))

+            (:section :class "link-content"

+             (:div :ng-bind-html "renderHtml(item.description)" ""))))))))

+     (:footer))))

@@ -54,8 +54,8 @@

 (sheeple:defreply get-user-info ((a =endpoint-schema=) (b sheeple:=string=)))

 (sheeple:defreply get-access-token ((a =endpoint-schema=) (b sheeple:=string=)))

-(defparameter *FBOOK-INFO* (sheeple:clone =service-info=))

-(defparameter *GOOG-INFO* (sheeple:clone =service-info=))

+(defparameter *fbook-info* (sheeple:clone =service-info=))

+(defparameter *goog-info* (sheeple:clone =service-info=))

 (defparameter *endpoint-schema* nil)

 ; goog is well behaved

 (defparameter *goog-endpoint-schema* (defobject (=endpoint-schema= *goog-info*)))

@@ -212,89 +212,112 @@

                                          ("access_token" . ,access-token))

                            ))))

+(defun google-login-entry (params)

+  (declare (ignore params))

+  (with-context-variables (session)

+    (let ((state (gen-state 36)))

+      (setf (gethash :state session) state)

+      (with-endpoints *goog-endpoint-schema*

+        (setf (gethash :endpoint-schema session) *goog-endpoint-schema*)

+        (multiple-value-bind (content rcode headers) (do-auth-request *goog-endpoint-schema* state)

+          (if (< rcode 400)

+            `(302 (:location ,(cdr (assoc :location headers))))

+            content))))))

+

+(defun facebook-login-entry (params)

+  (declare (ignore params))

+  (let ((session (ningle:context :session))

+        (state (gen-state 36)))

+      (setf (gethash :state session) state)

+      (with-endpoints *fbook-endpoint-schema*

+        (setf (gethash :endpoint-schema session) *fbook-endpoint-schema*)

+        (multiple-value-bind (content rcode headers uri) (do-auth-request *fbook-endpoint-schema* state)

+          (declare (ignore headers))

+          (if (< rcode 400)

+            `(302 (:location ,(format nil "~a" uri)))

+            content)))))

+

+(defun google-callback (login-callback)

+  (lambda (params)

+    (let ((received-state (cdr (string-assoc "state" params)))

+          (code (cdr (string-assoc "code" params))))

+      (check-state received-state

+                   (with-context-variables (session)

+                     (with-endpoints *goog-endpoint-schema*

+                       (let* ((a-t (get-access-token *goog-endpoint-schema* code))

+                              (access-token (assoc-cdr :access--token a-t)) ;; Argh

+                              (id-token (assoc-cdr :id--token a-t))

+                              (decoded (cljwt:decode id-token :fail-if-unsupported nil))

+                              (user-info (get-user-info *goog-endpoint-schema* access-token)))

+                         (setf (gethash :idtoken session) id-token

+                               (gethash :accesstoken session) access-token

+                               (gethash :userinfo session) user-info

+                               (gethash :app-user session) (funcall login-callback

+                                                                    user-info

+                                                                    decoded

+                                                                    access-token))

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

+                         )))

+                   '(403 '() "Out, vile imposter!")))))

+

+(defmacro setup-session ((session) &rest rest &key nonsense &allow-other-keys)

+  (declare (ignorable nonsense))

+  (cons 'progn

+        (iterate:iterate (iterate:for key   in rest       by #'cddr )

+                         (iterate:for value in (cdr rest) by #'cddr)

+                         (iterate:collect `(setf (gethash ,(alexandria:make-keyword (key)) ,session) ,value)))))

+

+(defun vars-to-symbol-macrolets (vars obj)

+  (iterate:iterate (iterate:for var in vars)

+                   (iterate:collect `(,var (gethash ,(alexandria:make-keyword var) ,obj)))))

+

+(defmacro with-session-values (vars session &body body)

+  (alexandria:once-only (session)

+    `(symbol-macrolet ,(vars-to-symbol-macrolets vars session)

+       ,@body)))

-(defun oauth2-login-middleware (&key google-info facebook-info (login-callback #'identity))

-  (lambda (app)

-    ;(in-package :cl-oid-connect)

-    (load-facebook-info facebook-info)

-    (load-goog-endpoint-schema)

-    (load-google-info google-info)

-

-    (def-route ("/login/google" (params) :app app)

-      (with-context-variables (session)

-        (let ((state (gen-state 36)))

-          (setf (gethash :state session) state)

-          (with-endpoints *goog-endpoint-schema*

-            (setf (gethash :endpoint-schema session) *goog-endpoint-schema*)

-            (multiple-value-bind (content rcode headers) (do-auth-request *goog-endpoint-schema* state)

-              (if (< rcode 400)

-                `(302 (:location ,(cdr (assoc :location headers))))

-                content))))))

-

-

-    (def-route ("/login/facebook" (params) :app app)

-      (let ((session (ningle:context :session)))

-        (let ((state (gen-state 36)))

-          (setf (gethash :state session) state)

-          (with-endpoints *fbook-endpoint-schema*

-            (setf (gethash :endpoint-schema session) *fbook-endpoint-schema*)

-            (multiple-value-bind (content rcode headers uri) (do-auth-request *fbook-endpoint-schema* state)

-              (declare (ignore headers))

-              (if (< rcode 400)

-                `(302 (:location ,(format nil "~a" uri)))

-                content))))))

-

-    (def-route ("/oidc_callback/google" (params) :app app)

-      (let ((received-state (cdr (string-assoc "state" params)))

-            (code (cdr (string-assoc "code" params))))

+(defun facebook-callback (login-callback)

+  (lambda (params)

+    (let ((received-state (cdr (string-assoc "state" params)))

+          (code (cdr (string-assoc "code" params))))

+      (with-endpoints *fbook-endpoint-schema*

         (check-state received-state

-                     (with-context-variables (session)

-                       (with-endpoints *goog-endpoint-schema*

-                         (let* ((a-t (get-access-token *goog-endpoint-schema* code))

-                                (access-token (assoc-cdr :access--token a-t)) ;; Argh

-                                (id-token (assoc-cdr :id--token a-t))

-                                (decoded (cljwt:decode id-token :fail-if-unsupported nil))

-                                (user-info (get-user-info *goog-endpoint-schema* access-token)))

-                           (setf (gethash :idtoken session) id-token)

-                           (setf (gethash :accesstoken session) access-token)

-                           (setf (gethash :userinfo session) user-info)

-                           (setf (gethash :app-user session)

-                                 (funcall login-callback user-info decoded access-token))

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

-                           )))

-                     '(403 '() "Out, vile imposter!"))))

-

-

-    (def-route ("/oidc_callback/facebook" (params) :app app)

-      (let ((received-state (cdr (string-assoc "state" params)))

-            (code (cdr (string-assoc "code" params))))

-        (with-endpoints *fbook-endpoint-schema*

-          (check-state received-state

-                       (with-context-variables (session)

-                         (let* ((a-t (get-access-token *fbook-endpoint-schema* code))

-                                (id-token (assoc-cdr :access--token a-t))

-                                (user-info (get-user-info *fbook-endpoint-schema* id-token)))

-                           (setf (gethash :accesstoken session) a-t)

-                           (setf (gethash :userinfo session) user-info)

-                           (setf (gethash :idtoken session) id-token)

-                           (setf (gethash :app-user session) (funcall login-callback user-info id-token a-t))

-

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

-                       '(403 '() "Out, vile imposter!")))))

-

-    (def-route ("/userinfo.json" (params) :app app)

-      (with-context-variables (session)

-        (require-login

-          (with-endpoints  (gethash :endpoint-schema session)

-            (cl-json:encode-json-to-string (gethash :userinfo session))))))

-

-    (def-route ("/logout" (params) :app app)

-      (with-context-variables (session)

-        (setf (gethash :userinfo session) nil)

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

-

-    app))

-

+                     (let* ((a-t (get-access-token *fbook-endpoint-schema* code))

+                            (id-token (assoc-cdr :access--token a-t))

+                            (user-info (get-user-info *fbook-endpoint-schema* id-token)))

+                       (with-session-values (accesstoken userinfo idtoken app-user) (context :session)

+                                            (setf accesstoken a-t

+                                                  userinfo user-info

+                                                  idtoken id-token

+                                                  app-user (funcall login-callback user-info id-token a-t)))

+

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

+                     '(403 '() "Out, vile imposter!"))))))

+

+(defun userinfo-route (params)

+  (declare (ignore params))

+  (with-context-variables (session)

+    (require-login

+      (with-endpoints  (gethash :endpoint-schema session)

+        (cl-json:encode-json-to-string (gethash :userinfo session))))))

+

+(defun logout-route (params)

+  (declare (ignore params))

+  (with-context-variables (session)

+    (setf (gethash :userinfo session) nil)

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

+

+(defun oauth2-login-middleware (app &key google-info facebook-info (login-callback #'identity))

+  (load-facebook-info facebook-info)

+  (load-goog-endpoint-schema)

+  (load-google-info google-info)

+  (setf (route app "/userinfo.json" :method :get) #'userinfo-route

+        (route app "/logout"  :method :get) #'logout-route

+        (route app "/login/google" :method :get) #'google-login-entry

+        (route app "/login/facebook" :method :get) #'facebook-login-entry 

+        (route app "/oidc_callback/google" :method :get) (google-callback login-callback)

+        (route app "/oidc_callback/facebook" :method :get) (facebook-callback login-callback))

+  (lambda (app) (lambda (env) (funcall app env))))

 (defmacro redirect-if-necessary (sessionvar &body body)

   (with-gensyms (session)

@@ -23,13 +23,6 @@

   (:use #:cl))

 (load "utils.lisp")

-(defpackage :whitespace.tables

-  (:use #:cl #:alexandria #:postmodern #:annot.class))

-(load "tables.lisp")

-

-(defpackage :whitespace.rss

-  (:use #:cl #:alexandria #:postmodern #:lquery #:cl-syntax #:cl-annot.syntax #:cl-annot.class

-        #:whitespace.tables #:iterate))

 (load "rss.lisp")

 (defpackage :whitespace

@@ -124,56 +117,7 @@

                              :href (format nil "#feed-~a" feed-count)

                              (rss-feed-title feed))))))))

-(defun base-template-f (&optional demo)

-  (cl-markup:xhtml5

-    (:head

-      (:title "Whitespace")

-      (:script :src "https://code.jquery.com/jquery-2.1.4.min.js" :type "text/javascript" "")

-      (:script :src "https://cdnjs.cloudflare.com/ajax/libs/angular.js/1.4.5/angular.js" :type "text/javascript" "")

-      (:script :src "https://cdnjs.cloudflare.com/ajax/libs/angular.js/1.4.5/angular-resource.js" :type "text/javascript" "")

-      (:script :src "https://cdnjs.cloudflare.com/ajax/libs/angular.js/1.4.5/angular-sanitize.js" :type "text/javascript" "")

-      (:script :src "/static/js/fold.js" :type "text/javascript" "")

-      (:script :src "/static/js/whitespace-angular.js" :type "text/javascript" "")

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

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

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

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

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

-      (:link :rel "stylesheet" :href "/theme/light.css")

-      (:link :rel "icon" :href "/static/images/Whitespace_favicon.png" :type "image/x-icon")

-      (:link :rel "shortcut icon" :href "/static/images/Whitespace_favicon.png" :type "image/x-icon"))

-

-    (:body :ng-app "whitespace" :ng-controller "MainCtrl"

-     (:header

-       (:button :class "flip-button" "…")

-       (:h1 "Whitespace")

-       )

-     (:section :id "content"

-      (:section :id "sidebar"

-       (cl-markup:raw (feedlist-markup *feeds*)))

-      (:main

-        (cl-markup:raw

-          (unless demo

-            (cl-markup:markup

-              (:form :name "add-form" :id "add-form" :ng-submit "addFeed()"

-               (:input :type "text" :name "url" :class "urltext" :ng-model "addForm.url" :placeholder "http://example.com/feed.rss . . ." "")

-               (:input :type "hidden" :name "api" :value "yes" "")

-               (:button :type "submit" :class "fsub" "+")))))

-        (:img :ng-class "{spinner: true, hide: feeds.result !== undefined}" :src "/static/images/spinner.gif" "")

-        (:section :ng-class "{feed: true, closed: !feed.closed}" :ng-repeat "feed in feeds.result"

-         (:section :class "feed-header" :ng-click "toggleClosed(feed)"

-          (:h2 "{{ feed.title }}")

-          (:h3 "{{ feed.description }}"))

-         (:ul :class "post-list"

-          (:li :ng-class "{link: true, closed: !item.closed}" :ng-repeat "item in feed.items"

-           (:section :class "link-header" :ng-click "toggleClosed(item)"

-            (:h4 "{{item.title}}")

-            (:p :class "link-info"

-             (:a :target "_blank" :ng-href "{{item.link}}" :class "link-url" "{{item.link}}")

-             (:span :class "link-date" "{{item.date}}")))

-           (:section :class "link-content"

-            (:div :ng-bind-html "renderHtml(item.description)" "")))))))

-      (:footer))))

+(load "base-template.lisp")

 (defmacro defun-from-value (name value)

   `(setf (symbol-function ',name) ,value))

@@ -190,7 +134,7 @@

 ; ; ;  Ultimately, this will only serialize the feed if the client

 (cl-oid-connect:def-route ("/feeds/add" (params) :method :post :app *app*)

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

-    (let ((user-info (car (gethash :app-user session)))

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

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

           (api (string= (cl-oid-connect:assoc-cdr "api" params 'string=) "yes")) 

           (url (cl-oid-connect:assoc-cdr "url" params 'string=)) 

@@ -199,10 +143,11 @@

         (when (neither-null params user-info)

           (handler-case

             (let* ((doc (plump:parse (drakma:http-request url)))

-                   (uid (slot-value user-info 'id))

-                   (added-feed (store-feed doc uid)))

-              (when api

-                (setf result `(200 (:Content-Type "application/json") ,(jsonapi-encoder t added-feed)))))

+                   (uid (slot-value user-info 'id)))

+              (multiple-value-bind (added-feed dao-feed) (store-feed doc) 

+                (subscribe-to-feed uid (slot-value dao-feed 'id))

+                (when api

+                  (setf result `(200 (:Content-Type "application/json") ,(jsonapi-encoder t added-feed))))))

             (cl-postgres-error:unique-violation

               ()

               (when api

@@ -235,8 +180,7 @@

     (let* ((received-id (anaphora:aif (cl-oid-connect:assoc-cdr :id userinfo)

                           anaphora:it

                           (cl-oid-connect:assoc-cdr :sub userinfo)))

-           (db-user (postmodern:query-dao 'reader_user (:select :* :from 'reader_user

-                                                        :where (:= :foreign-id received-id)))))

+           (db-user (car (postmodern:select-dao 'reader_user (:= :foreign-id received-id)))))

       (if (not (null db-user))

         db-user

         (progn

@@ -290,7 +234,6 @@

                    `(* :color ,(colors:colorscheme-fg *colorscheme*))

                    `(body

-                      :transition "background-color 0.25s ease"

                       :background-color ,(colors:colorscheme-bg *colorscheme*))

                    `((:or h1 h2 h3)

@@ -314,12 +257,13 @@

                        :font-size ,(combine-unit-q (* 0.25 header-height) height-units)))

                    `(main

-                      :border-left thin solid ,(colors:colorscheme-accent *colorscheme*)

+                      :border-left medium solid ,(colors:colorscheme-accent *colorscheme*)

                       :height ,(combine-unit-q (- 100 header-height) height-units)

-                      (.add-form

+                      ("#add-form"

+                        :box-shadow "0em" "0em" "0.2em" "0.2em" ,(colors:colorscheme-accent *colorscheme*)

                         ((:or input button)

-                          :background-color ,(colors:colorscheme-fg *colorscheme*)

-                          :color ,(colors:colorscheme-bg *colorscheme*))

+                         :background-color ,(colors:colorscheme-bg *colorscheme*)

+                         :color ,(colors:colorscheme-fg *colorscheme*))

                         )

                       )

@@ -379,6 +323,13 @@

 (ql:quickload :clack-middleware-postmodern)

+(defparameter oid-mw

+  (cl-oid-connect:oauth2-login-middleware

+    *app*

+    :facebook-info (truename "~/github_repos/cl-oid-connect/facebook-secrets.json")

+    :google-info (truename "~/github_repos/cl-oid-connect/google-secrets.json")

+    :login-callback #'login-callback))

+

 (defun start (&optional tmp)

   (let ((server (if (> (length tmp) 1)

                   (intern (string-upcase (elt tmp 1)) 'keyword)

@@ -392,12 +343,13 @@

                               (postmodern:with-connection *db-connection-info*

                                 (funcall app env))))

               (:static :path "/static/" :root #p"./static/")

-              (funcall

-                (cl-oid-connect:oauth2-login-middleware

-                  :facebook-info (truename "~/github_repos/cl-oid-connect/facebook-secrets.json")

-                  :google-info (truename "~/github_repos/cl-oid-connect/google-secrets.json")

-                  :login-callback #'login-callback)

-                *app*)) :port 9090 :server server)

+              *app*) :port 9090 :server server)

           *handler*)))

+

+(defun restart-clack ()

+  (do () ((null *handler*))

+    (stop))

+  (start))

+

 ; vim: foldmethod=marker foldmarker=(,) foldminlines=3 :

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

 (:import "url(https://fonts.googleapis.com/css?family=Lato:400,100,300,400italic,300italic,700,700italic,900&subset=latin,latin-ext)")

 (:import "url(https://fonts.googleapis.com/css?family=Caudex)")

-((:or .feed main)

-  :-webkit-backface-visibility hidden;

-  :-webkit-transform "translateZ(0)")

+;((:or .feed main)

+;  :-webkit-backface-visibility hidden;

+;  :-webkit-transform "translateZ(0)")

 (*

   :box-sizing "border-box"

@@ -11,6 +11,7 @@

   :padding "0px")

 (body

+  :transition "background-color .5s ease"

   :font-family "Lato")

 (((:or main "#sidebar" .feed) > (:or ul ol))

@@ -51,9 +52,8 @@

   (ul.menu

     :text-align right

     :font-variant small-caps

-    :opacity 0

     (li

-      :transition "all 0.25s ease"

+      :transition "all .5s ease"

       (a

         :color inherit

         :display block

@@ -62,17 +62,21 @@

         :padding "0.5em"

         :text-decoration none

         :width "100%"

-        )))

-  (ul.menu.open

-    :opacity 1))

+        ))))

 (main

   :width "62vw"

   :float "right"

   :clear "right"

-  :overflow-x "hidden"

-  :overflow-y "scroll"

-  :position "relative")

+  :overflow "hidden"

+  :position "relative"

+  ((> div)

+   :position "absolute"

+   :top "2em"

+   :bottom "0em"

+   :width "100%"

+   :overflow-y "scroll")

+  )

 (img.spinner

   :position "absolute"

@@ -89,12 +93,12 @@

   ((:or h2 h3) :padding "0.62em")

   (h2 :padding-bottom "0.38em")

   (h3 :padding-top "0.38em")

-  :transition "background-color 0.25s ease"

+  :transition "background-color .5s ease"

   :padding-bottom "0em")

 ((.link.closed .link-content) 

-  :max-height "0px"

-  :padding "0em")  

+ :max-height "0px"

+ :padding "0em")  

 (.link.closed

   :padding-bottom "0em")

@@ -108,7 +112,7 @@

     :padding "1em"

     :padding-bottom "0em"

     :cursor pointer

-    :transition "background-color 0.25s ease"

+    :transition "background-color .5s ease"

     (h4

       :margin-bottom "0.5em"

       :display "inline-block")) 

@@ -129,7 +133,7 @@

    :clear both)

   (.link-content

     :overflow hidden

-    

+

     (img

       :margin "1em" "0%" "1em" "10%"

       :max-width "80%"

@@ -157,27 +161,34 @@

     :transition "max-height 0.5s ease"))

 ("#add-form"

-  :font-size "1em"

-  :height "1.8em"

-  :display block

-  :overflow hidden

-  :width "100%"

-

-  (input

-    :border "none"

-    :width "95%"

-    :height "100%"

-    :font-size "0.8em"

-    :line-height "1.8em"

-    :padding "1em" "0.5em"

-    )

-  (button

-    :border none

-    :border-radius 0px

-    :font-size inherit

-    :width "5%" 

-    :height "100%"

-    ))

+ :transition "background-color .5s ease"

+ :font-size "1em"

+ :height "1.8em"

+ :display block

+ :overflow hidden

+ :width "100%"

+ :position absolute

+ :z-index 3

+

+ ((:or input button)

+  :transition "background-color .5s ease"

+  )

+

+ (input

+   :border "none"

+   :width "95%"

+   :height "100%"

+   :font-size "0.8em"

+   :line-height "1.8em"

+   :padding "1em" "0.5em"

+   )

+ (button

+   :border none

+   :border-radius 0px

+   :font-size inherit

+   :width "5%" 

+   :height "100%"

+   ))

 (.flip-button

@@ -1,7 +1,7 @@

 (in-package :angular)

 ;:action "/feeds/add?api=yes" :name "add-form" :id "add-form" :method "post" 

-(def-module whitespace '(ng-resource ng-sanitize)

+(defmodule whitespace '(ng-resource ng-sanitize)

   (defcontroller -Main-Ctrl ($http $resource $sce)

     (resource feeds "/feeds" nil

               (json (method "GET" url "/feeds/json"))

@@ -1,12 +1,48 @@

-;(in-package :cl-user)

-;(defpackage :whitespace.rss

-;  (:shadow "to-json")

-;  (:use #:cl #:alexandria #:postmodern #:lquery #:cl-syntax #:cl-annot.syntax #:cl-annot.class

-;        #:whitespace.tables #:iterate))

+(in-package :cl-user)

+

+(load "tables.lisp")

+

+(defpackage :whitespace.rss

+  (:use #:cl #:alexandria #:postmodern #:lquery #:cl-syntax #:cl-annot.syntax #:cl-annot.class

+        #:whitespace.tables #:iterate)

+  (:import-from anaphora it))

+

 (in-package :whitespace.rss)

 (cl-annot.syntax:enable-annot-syntax)

+(defun ensure-mapping (list)

+  "Make sure that each item of the list is a pair of symbols"

+  (mapcar (lambda (x) (if (symbolp x) (list x x) x)) list))

+

+(defun alist-string-hash-table (alist)

+  (alexandria:alist-hash-table alist :test #'string=))

+

+(defun transform-alist (pair-transform alist)

+  (iterate (for (k . v) in-sequence alist)

+           (collect

+             (funcall pair-transform k v))))

+

+(defun %json-pair-transform (k v)

+  (cons (make-keyword (string-downcase k))

+        (typecase v

+          (string (coerce v 'simple-string))

+          (t v))))

+

+(defun %default-pair-transform (k v)

+  (cons (make-keyword (string-upcase k)) v))

+

+(defun make-pairs (symbols)

+  (cons 'list (iterate (for (key value) in symbols)

+                       (collect (list 'list* (symbol-name key) value)))))

+

+@export

+(defmacro copy-slots (slots from-v to-v)

+  (with-gensyms (from to)

+    `(let ((,from ,from-v) (,to ,to-v))

+       ,@(iterate (for (fro-slot to-slot) in (ensure-mapping slots))

+                  (collect `(setf (slot-value ,to ',to-slot) (slot-value ,from ',fro-slot))))

+       ,to)))

 @export

 (defmacro default-when (default test &body body)

@@ -15,6 +51,54 @@

            ,@body)

          ,default)))

+@export

+(defmacro get-elements (feed &optional (filter nil))

+  (let ((feed-sym (gensym))

+        (filter-lis `(lambda (x) (and (plump-dom:element-p x) ,@(loop for x in filter

+                                                                      collect `(funcall ,x x))))))

+    `(let ((,feed-sym ,feed))

+       (remove-if-not ,filter-lis (plump:children ,feed-sym)))))

+

+@export

+(defmacro get-elements-by-tagname (feed tagname)

+  `(get-elements ,feed ((lambda (x) (string= ,tagname (plump:tag-name x))))))

+

+@export

+(defmacro extract-text (selector &optional (default ""))

+  `(or (lquery:$ ,selector (text) (node)) ,default))

+

+(defmacro transform-result ((list-transform pair-transform) &body alist)

+    `(funcall ,list-transform

+              (transform-alist ,pair-transform

+                               ,@alist)))

+

+

+(defmacro slots-to-pairs (obj (&rest slots))

+  (alexandria:once-only (obj)

+    (let ((slots (ensure-mapping slots)))

+      `(with-slots ,(mapcar #'cadr slots) ,obj

+         ,(make-pairs slots)))))

+

+(defmacro defserializer ((specializes) &body slots)

+  (with-gensyms (obj o-t p-t)

+    `(defmethod serialize ((,obj ,specializes) &optional (,o-t #'identity) (,p-t #'%default-pair-transform))

+      (transform-result (,o-t ,p-t)

+        (slots-to-pairs ,obj ,slots)))))

+

+@export

+(defmacro xml-text-bind (syms &body body)

+  "Bind the symbols passed in the second arg to the text of the matching

+   elements in the document lquery has been initialized with and then run the

+   body in the resulting lexical scope.  This assumes that lquery:initialize

+   has already been passed the proper xml document"

+  `(let* ,(loop for sym in syms

+           collect `(,sym (or (lquery:$ ,(symbol-name sym) (text) (node)) "")))

+     ,@body))

+

+(defmacro make-instance-from-symbols (class &rest initargs)

+  `(make-instance ,class ,@(iterate (for (to from) in (ensure-mapping initargs))

+                                    (appending (list (make-keyword (symbol-name to)) from)))))

+

 @export-class

 (defclass rss-feed ()

   ((feed :accessor rss-feed-feed :initarg :feed)

@@ -22,7 +106,8 @@

    (title :accessor rss-feed-title :initarg :title)

    (link :accessor rss-feed-link :initarg :link)

    (description :accessor rss-feed-description :initarg :description)

-   (items :accessor rss-feed-items :initarg :items)))

+   (items :accessor rss-feed-items :initarg :items)

+   (fetch-url :accessor fetch-url :initarg :fetch-url)))

 @export-class

 (defclass rss-item ()

@@ -38,79 +123,131 @@

    (pub-date :accessor rss-item-pub-date :initarg :pub-date)

    (source :accessor rss-item-source  :initarg :source)))

-(load "tables.lisp")

+@export

+(defun make-rss-feed (feed)

+  (lquery:initialize feed)

+  (let* ((channel (lquery:$ "channel" (node)))

+         (fetch-url (lquery:$ "channel" (children) (tag-name "atom:link") (filter "[rel=self]") (attr :href) (node)))

+         (link (lquery:$ "channel > link" (text) (node)))

+         (link (if (string= link "") (lquery:$ "channel" (children) (tag-name "atom:link") (attr :href) (node)) link))

+         (items (lquery:$ "item")))

+    (xml-text-bind (title description)

+      (make-instance-from-symbols 'rss-feed

+                                  feed title link description channel fetch-url

+                                  (items (iterate (for it in-sequence items)

+                                                  (collecting (make-rss-item it))))))))

+

+@export

+(defgeneric serialize (cls &optional output-transform pair-transform))

-(defmethod jonathan:%to-json ((obj rss-feed)) (jonathan:%to-json (serialize obj

-                                                                            #'alexandria:alist-hash-table

-                                                                            #'%json-pair-transform)))

-(defmethod jonathan:%to-json ((obj rss-item)) (jonathan:%to-json (serialize obj

-                                                                            #'alexandria:alist-hash-table

-                                                                            #'%json-pair-transform)))

-(defun alist-string-hash-table (alist)

-  (alexandria:alist-hash-table alist :test #'string=))

+(defmethod serialize ((obj sequence) &optional (o-t #'identity) (p-t #'%default-pair-transform))

+  (iterate (for item in-sequence obj)

+           (collect (serialize item o-t p-t))))

-(defun transform-alist (pair-transform alist)

-  (iterate (for (k . v) in-sequence alist)

-           (collect

-             (funcall pair-transform k v))))

+; These are the interface I'm planning to remove as duplicate

+(defserializer (rss-feed)

+  title link description fetch-url

+  (items (iterate (for item in items)

+                  (collect item))))

-(defun %json-pair-transform (k v)

-  (cons (make-keyword k)

-        (typecase v

-          (string (coerce v 'simple-string))

-          (t v))))

+(defserializer (rss-item)

+  title link (description description-raw) guid pub-date source)

-(defun %default-pair-transform (k v)

-  (cons (make-keyword (string-upcase k)) v))

+; this is the interface to be used

+(defserializer (rss_feed_store)

+  title link description fetch-url)

+

+(defserializer (rss_item_store)

+  title link description fetch-url)

+

+(defmethod jonathan:%to-json ((obj rss-feed))

+  (jonathan:%to-json (serialize obj #'alexandria:alist-hash-table #'%json-pair-transform)))

+

+(defmethod jonathan:%to-json ((obj rss-item))

+  (jonathan:%to-json (serialize obj #'alexandria:alist-hash-table #'%json-pair-transform)))

+

+(defmacro get-id-for-object ((table key-column &optional (id-column :id)) key &body body)

+  "Anaphoric macro: binds id to the id it retrieves!"

+  (once-only (id-column key)

+    `(let ((id (anaphora:awhen (postmodern:query (:select ,id-column :from ',table :where (:= ',key-column ,key)))

+                 (caar it))))

+       ,@body)))

+

+(defgeneric get-dao-for (obj &optional link)

+  ; NOTE: this won't make dao objects for the _items_ when called on the feed!

+  ; also NOTE: this _prefers_ the passed object

+  (:method ((obj rss-feed) &optional linked-objects)

+   (declare (ignore linked-objects))

+   (with-slots (title link description fetch-url) obj

+     (get-id-for-object (rss_feed_store link) link

+       (make-instance-from-symbols 'rss_feed_store id title link description fetch-url (fetch-defaults t))) ))

+

+  (:method ((obj rss-item) &optional feed)

+   (with-slots (title link description-raw guid pub-date source) obj

+     (get-id-for-object (rss_item_store guid) guid

+       (make-instance-from-symbols 'rss_item_store id title link (description description-raw)

+                                   guid pub-date source feed (fetch-defaults t))))))

 @export

-(defgeneric serialize (cls &optional output-transform pair-transform)

-  (:method ((obj sequence) &optional (output-transform #'identity) (pair-transform #'%default-pair-transform))

-   (iterate (for item in-sequence obj)

-            (collect (serialize item output-transform pair-transform))))

+(defun get-feed-from-dao (rss-feed)

+  (let ((feed-dao (get-dao-for rss-feed)))

+    (list feed-dao

+          (with-slots (items) rss-feed

+            (iterate (for item in items)

+                     (collect (get-dao-for item (slot-value feed-dao 'id))))))))