@@ -28,7 +28,6 @@

 (load "tables.lisp")

 (defpackage :whitespace.rss

-  (:shadow "to-json")

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

         #:whitespace.tables #:iterate))

 (load "rss.lisp")

@@ -156,9 +155,9 @@

         (cl-markup:raw

           (unless demo

             (cl-markup:markup

-              (:form :action "/feeds/add" :name "add-form" :id "add-form" :method "post"

-               (:input :type "text" :name "url" :class "urltext" "")

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

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

@@ -190,25 +189,27 @@

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

-    (cl-oid-connect:require-login

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

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

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

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

+    (let ((user-info (car (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=)) 

+          (plump-parser:*tag-dispatchers* plump-parser:*xml-tags*))

+      (cl-oid-connect:require-login

         (when (neither-null params user-info)

           (handler-case

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

-                   (feed (drakma:http-request url))

-                   (plump-parser:*tag-dispatchers* plump-parser:*xml-tags*)

-                   (doc (plump:parse feed)))

-              (store-feed doc (slot-value user-info 'id))

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

-            (cl-postgres-error:unique-violation ()

-                                                (when api

-                                                  (setf result

-                                                        `(400 () ,(jsonapi-encoder nil "Feed already saved")))))))

-        result))))

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

+            (cl-postgres-error:unique-violation

+              ()

+              (when api

+                (setf result

+                      `(400 () ,(jsonapi-encoder nil "Feed already saved"))))))))

+      result)))

+

 ;;; TODO: add needs to return the new content, so that angular can append it

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

@@ -399,3 +400,4 @@

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

           *handler*)))

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

@@ -34,68 +34,83 @@

 (load "tables.lisp")

-(setf (symbol-function 'rss-item-encoder)

-      (jonathan.helper:compile-encoder () (title link description category comments enclosure guid

-                                                 pub-date source)

-        (list :|title| title :|link| link :|description| description

-              :|category| category :|comments| comments :|enclosure| enclosure

-              :|guid| guid :|pub-date| pub-date :|source| source)))

-

-(setf (symbol-function 'rss-feed-encoder)

-      (jonathan.helper:compile-encoder () (title link description items)

-        (list :|title| title :|link| link :|description| description :|items| items)))

-

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

-  (jonathan:with-object

-    (jonathan:write-key-value "title" (coerce (rss-feed-title obj) 'simple-string))

-    (jonathan:write-key-value "link" (coerce (rss-feed-link obj) 'simple-string))

-    (jonathan:write-key-value "description" (coerce (rss-feed-description obj) 'simple-string))

-    (jonathan:write-key-value "items" (rss-feed-items obj))))

-

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

-  (jonathan:with-object

-    (jonathan:write-key-value "title" (coerce (rss-item-title obj) 'simple-string))

-    (jonathan:write-key-value "link" (coerce (rss-item-link obj) 'simple-string))

-    (jonathan:write-key-value "description" (coerce (rss-item-description-raw obj) 'simple-string))

-    ;(jonathan:write-key-value "category" (rss-item-category obj))

-    (jonathan:write-key-value "comments" (coerce (rss-item-comments obj) 'simple-string))

-    (jonathan:write-key-value "enclosure" "rss-item-enclosure obj")

-    (jonathan:write-key-value "guid" (coerce (rss-item-guid obj) 'simple-string))

-    (jonathan:write-key-value "date" (coerce (rss-item-pub-date obj) 'simple-string))

-    (jonathan:write-key-value "source" (coerce (rss-item-source obj) 'simple-string))))

-

-@export

-(defgeneric serialize (cls &rest links)

-  (:method ((obj list) &rest ignored)

-   (declare (ignore ignored))

-   (loop for item in obj

-         collect (serialize item)))

-

-  (:method ((obj vector) &rest ignored)

-   (declare (ignore ignored))

-   (loop for item across obj

-         collect (serialize item)))

-

-  (:method ((obj rss-feed) &rest ignored)

-   (declare (ignore ignored))

-   (let ((feed (postmodern:make-dao

-                 'rss_feed_store

-                 :title (rss-feed-title obj) :link (rss-feed-link obj) :description (rss-feed-description obj))))

-     (format t "~a~%" (rfs-link feed))

-     (loop for item in (rss-feed-items obj)

-           collect (serialize item (rfs-id feed)))

-     feed))

-

-  (:method ((obj rss-item) &rest links)

-   (let ((feed (car links)))

-     (format t "~a~%" feed)

-     (postmodern:make-dao 'rss_item_store

-                          :title (rss-item-title obj)

-                          :link (rss-item-link obj)

-                          :description (rss-item-description-raw obj)

-                          :guid (rss-item-guid obj) :pub-date (rss-item-pub-date obj)

-                          :source (rss-item-source obj)

-                          :feed feed))))

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

+

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

+        (typecase v

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

+          (t v))))

+

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

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

+

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

+

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

+   (funcall output-transform

+     (transform-alist pair-transform

+                      `(("title" . ,(rss-feed-title obj))

+                        ("link" . ,(rss-feed-link obj))

+                        ("description" . ,(rss-feed-description obj))

+                        ("items" . ,(iterate (for item in-sequence (rss-feed-items obj))

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

+

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

+   (funcall output-transform

+     (transform-alist pair-transform

+                      `(("title" . ,(rss-item-title obj))

+                        ("link" . ,(rss-item-link obj))

+                        ("description" . ,(rss-item-description-raw obj))

+                        ("guid" . ,(rss-item-guid obj))

+                        ("pub-date" . ,(rss-item-pub-date obj))

+                        ("source" . ,(rss-item-source obj)))))))

+

+@export

+(defun store-feed-dao (serialized-rss-feed &optional link)

+  (declare (ignore link))

+  (let* ((items nil)

+         (rss_feed (eval `(postmodern:make-dao

+                            'rss_feed_store

+                            ,@(iterate (for (k . v) in-sequence serialized-rss-feed)

+                                       (if (eql k :items)

+                                         (setf items v)

+                                         (appending (list k v))))))))

+    (iterate (for item in items)

+             (store-item-dao item (slot-value rss_feed 'id)))

+    rss_feed))

+

+@export

+(defun store-item-dao (rss-item link)

+ (eval `(postmodern:make-dao

+          'rss_item_store

+          :feed ,link

+          ,@(iterate (for (k . v) in-sequence rss-item)

+                     (appending (list k v))))))

+

+#|

+(:documentation

+  "Store a serialized rss object into rhe database: the basic idea here is

+   that the quasi-quoted expression generates a form that would insert the

+   item and then we eval it.")

+|#

 @export

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

@@ -105,7 +120,6 @@

                 in (mapcar (lambda (x) (if (symbolp x) (list x x) x)) slots)

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

-

 @export

 (defun deserialize-item (item)

   (let ((result (make-instance 'rss-item)))

@@ -197,7 +211,7 @@

            (description-munged (dehtml description-raw))

            (category (get-category-names (lquery:$ "category"))))

            ;(enclosure) --- TODO: implement comment / enclosure handling

-           

+

       (xml-text-bind (title link guid pub-date source comments)

         (make-instance 'rss-item :item item

                        :title title :link link :description-raw description-raw :description description-munged

@@ -223,6 +237,7 @@

            (feedid (anaphora:aif (postmodern:query (:select 'id :from 'rssfeed

                                                     :where (:= 'link (rss-feed-link rss-feed-))))

                      (caar anaphora:it) ;; The postmodern query returns a nested list

-                     (slot-value (serialize rss-feed-) 'id))))

+                     (slot-value (store-feed-dao (serialize rss-feed-)) 'id))))

       (postmodern:query

-        (:insert-into 'subscriptions :set 'uid uid 'feedid feedid)))))

+        (:insert-into 'subscriptions :set 'uid uid 'feedid feedid))

+      rss-feed-)))