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

-all: ccl

+all: sbcl

 sbcl:

 	sbcl --no-userinit --disable-debugger --load deploy.lisp

@@ -13,7 +13,8 @@

                #:ubiquitous

                #:uiop

                #:vector-update-stream

-               #:yason)

+               #:yason

+               #:html-sanitizer)

   :serial t

   :components ((:file "package")

                (:file "tools")

@@ -30,17 +30,17 @@ root = new Vue({

         feed_item_counts: {},

-	likes: [],

-	show_likes: true,

+        likes: [],

+        show_likes: true,

     },

     computed: {

-	feed_visible() {

-	    return (!this.show_likes) &&

-		this.current_feed.metadata.title !== null &&

-		this.current_feed.items.length > 0;

-	},

-	

+        feed_visible() {

+            return (!this.show_likes) &&

+                this.current_feed.metadata.title !== null &&

+                this.current_feed.items.length > 0;

+        },

+        

         item_content() {

             let result = null;

             if (this.current_item.content !== null) {

@@ -54,18 +54,18 @@ root = new Vue({

     },

     methods: {

-	list_likes() {

-	    this.likes = []

-	    oboe('events.json')

-		.node('*', (ev) => {

-		    let {event} = ev;

-		    if (event === 'like-item') {

-			this.likes.push(ev);

-		    }

-		});

-	    this.show_likes = !this.show_likes;

-	},

-	

+        list_likes() {

+            this.likes = []

+            oboe('events.json')

+                .node('*', (ev) => {

+                    let {event} = ev;

+                    if (event === 'like-item') {

+                        this.likes.push(ev);

+                    }

+                });

+            this.show_likes = !this.show_likes;

+        },

+        

         toggleCollapse() {

             this.collapsed = !this.collapsed;

         },

@@ -79,7 +79,7 @@ root = new Vue({

         get_remote_feed: function (path) {

             var promise = new Promise((resolve, reject) => {

-                window.fetch(path+'index.json').then((resp) => resp.json())

+                window.fetch(path).then((resp) => resp.json())

                     .then((data) => {

                         var result = Object.assign({}, data);

                         result.fetch_url = data['fetch-url'];

@@ -97,43 +97,43 @@ root = new Vue({

         get_feed: function (path) {

             this.get_remote_feed(path)

                 .then((result) => Vue.set(this, 'current_feed', result))

-		.then(() => this.show_likes = false);

-	},

+                .then(() => this.show_likes = false);

+        },

         like(item, feed) {

-          fetch('https://<URL>/hub/feed_archive', {

-            method: 'POST',

-            body: JSON.stringify({

-              'event': 'like-item',

-              'item': item.link,

-              'title': item.title,

-              'author': item.author,

-              'feed-title': feed.metadata.title,

-              'feed-link': feed.metadata.link,

-            }),

-          });

+            fetch('https://<URL>/hub/feed_archive', {

+                method: 'POST',

+                body: JSON.stringify({

+                    'event': 'like-item',

+                    'item': item.link,

+                    'title': item.title,

+                    'author': item.author,

+                    'feed-title': feed.metadata.title,

+                    'feed-link': feed.metadata.link,

+                }),

+            });

         },

         get_item(path) {

-          window.fetch(this.current_feed.base_path + path).then((resp) => resp.json())

-          .then((data) => {

-            fetch('https://<URL>/hub/feed_archive', {

-              method: 'POST',

-              body: JSON.stringify({

-                'event': 'read-item',

-                'item': data.link,

-                'title': data.title,

-                'author': data.author,

-                'feed-title': this.current_feed.metadata.title,

-                'feed-link': this.current_feed.metadata.link,

-              }),

-            });

-            window.history.pushState({

-              'current_feed': root.current_feed,

-              'current_item': data

-            }, "", window.location.pathname);

-            Object.assign(this.current_item, data);

-          });

+            window.fetch(this.current_feed.base_path + path).then((resp) => resp.json())

+                .then((data) => {

+                    fetch('https://<URL>/hub/feed_archive', {

+                        method: 'POST',

+                        body: JSON.stringify({

+                            'event': 'read-item',

+                            'item': data.link,

+                            'title': data.title,

+                            'author': data.author,

+                            'feed-title': this.current_feed.metadata.title,

+                            'feed-link': this.current_feed.metadata.link,

+                        }),

+                    });

+                    window.history.pushState({

+                        'current_feed': root.current_feed,

+                        'current_item': data

+                    }, "", window.location.pathname);

+                    Object.assign(this.current_item, data);

+                });

         },

         has_items(feed) {

@@ -144,14 +144,14 @@ root = new Vue({

     },

     ready() {

-	oboe('events.json')

-	    .node('*', (ev) => {

-		let {event} = ev;

-		if (event === 'like-item') {

-		    this.likes.push(ev);

-		}

-	    });

-	

+        oboe('events.json')

+            .node('*', (ev) => {

+                let {event} = ev;

+                if (event === 'like-item') {

+                    this.likes.push(ev);

+                }

+            });

+        

         window.fetch(baseUrl+'/index.json').then((resp) => resp.json())

             .then(function (data) {

                 root.pull_time = data['pull-time'];

@@ -161,7 +161,7 @@ root = new Vue({

             })

             .then((data) => {

                 root.feeds.forEach((feed) => {

-		    // console.log(feed);

+                    // console.log(feed);

                     this.get_remote_feed(feed.path)

                         .then((feed_index) => Vue.set(this.feed_item_counts, feed.path, feed_index.items.length));

                 });

@@ -111,7 +111,7 @@

 (defmethod store ((item alimenta:item) (stream stream))

   (yason:with-output (stream :indent t)

-    (yason:encode-object item))

+    (yason:encode-slots item))

   (list (alimenta:title item)

         stream))

@@ -139,7 +139,6 @@

 (defmethod stream-provider:get-nested-provider ((provider stream-provider:stream-provider) (streamable alimenta:feed))

   (with (items-root (uiop:merge-pathnames* (uiop:pathname-directory-pathname (stream-provider:stream-key provider streamable))

                                            (stream-provider:root provider)))

-    (format t "~&items-root: ~a   @#%@#$^#$&^&%$~%" items-root) (terpri)

     (ensure-gethash items-root

                     (item-providers provider)

                     (make-instance 'stream-provider:file-provider :root items-root))))

@@ -153,6 +152,16 @@

   (stream-provider:with-storage-stream (s item stream-provider)

     (store item s)))

+(defmethod store :around ((item alimenta:item) (dest stream-provider:stream-provider))

+  (with-simple-restart (skip-item "Skip item ~s" (car item))

+    (call-next-method)))

+

+(defun map-coalesce (fun &rest seqs)

+  (apply #'mappend

+         (compose #'unsplice

+                  fun)

+         seqs))

+

 (defmethod store ((feed alimenta:feed) (stream-provider stream-provider:stream-provider))

   (stream-provider:with-storage-stream (s feed stream-provider)

     (with-accessors ((description alimenta:description)

@@ -162,15 +171,12 @@

                      (source-type alimenta:source-type)

                      (title alimenta:title)) feed

       (let* ((item-provider (stream-provider:get-nested-provider stream-provider feed))

-             (item-storage-info (map 'list (op (store _ item-provider))

-                                                        items)))

+             (item-storage-info (map-coalesce (op (store _ item-provider))

+                                              items)))

         (yason:with-output (s :indent t)

-          (yason:with-object ()

-            (yason:encode-object-element "metadata" feed)

-            (yason:with-object-element ("items")

-              (yason:with-array ()

-                (dolist (item item-storage-info)

-                  (destructuring-bind (title path) item

-                    (yason:with-object ()

-                      (yason:encode-object-elements "title" title

-                                                    "path" path))))))))))))

+          (with-collection (item "items" item-storage-info "metadata" feed)

+            (destructuring-bind (title path) item

+              (yason:with-object ()

+                (yason:encode-object-elements

+                 "title" title

+                 "path" path)))))))))

@@ -17,6 +17,7 @@

 (defun test-feed-list ()

   (values '("http://feeds.feedburner.com/GamasutraFeatureArticles/"

+            "http://edwardfeser.blogspot.com/feeds/posts/default"

             "https://www.codinghorror.com/blog/index.xml"

             "https://sancrucensis.wordpress.com/feed/")

           #p"/tmp/feed-archive/"))

@@ -50,8 +51,14 @@

                  (continue)))))

     (handler-bind ((warning #'muffle-warning)

                    (error #'pop-50-tokens))

-      (prog1 (alimenta.pull-feed:pull-feed feed-url)

+      (prog1-bind (feed (alimenta.pull-feed:pull-feed feed-url))

         ;; Why am I decf-ing here?

+        (alimenta:transform feed

+                            (fw.lu:glambda (entity)

+                              (:method (entity))

+                              (:method ((entity alimenta:item))

+                                (setf (alimenta:content entity)

+                                      (html-sanitizer:sanitize (alimenta:content entity))))))

         (decf pop-times)))))

 (defmacro with-progress-message ((stream before after &optional (error-msg " ERROR~%~4t~a~%")) &body body)

@@ -70,10 +77,6 @@

   (with-output-to-file (s output-file :if-exists if-exists)

     (plump:serialize (alimenta:doc feed) s)))

-(defun pull-and-store-feeds (feeds pull-directory)

-  (mapcar (op (pull-and-store-feed _ pull-directory))

-          feeds))

-

 (defun log-pull (feed-puller feed-url stream)

   (let ((before-message (concatenate 'string "Trying to pull: " feed-url)))

     (with-progress-message (stream before-message "Success")

@@ -85,44 +88,57 @@

                         :key 'alimenta:date))

 (defun log-serialization (feed-url stream feed path)

+  (declare (ignorable feed-url stream feed path))

   (with-progress-message (stream "Serializing XML" (format nil "done with ~a" feed-url))

     (save-feed feed (merge-pathnames "feed.xml" path))))

 (defun feed-relative-pathname (path &optional (feed-base *feed-base*))

   (uiop:enough-pathname path feed-base))

-(defun pull-and-store-feed (feed-url pull-directory &optional (feed-puller #'safe-pull-feed))

+(defun feed-index (index-stream pull-time references)

+  (yason:with-output (index-stream :indent t)

+    (yason:encode-object

+     (make-feed-index pull-time (remove-if 'null references)))))

+

+(defun pull-and-store-feed (feed-url stream-provider &optional (feed-puller #'safe-pull-feed))

   (flet ((log-pull (stream)

            (declare (inline) (dynamic-extent stream))

            (log-pull feed-puller feed-url stream))

          (log-serialization (stream feed path)

            (declare (inline) (dynamic-extent stream))

-           (log-serialization feed-url stream feed path)))

+           (log-serialization feed-url stream feed

+                              (merge-pathnames path

+                                               (stream-provider:root stream-provider)))))

     (with-simple-restart (skip-feed "Stop processing for ~a" feed-url)

       (let* ((feed (with-retry ("Pull feed again.")

                      (normalize-feed feed-url (log-pull t)))))

-        (trivia:multiple-value-match (store feed pull-directory)

-          (((list title path) url)

+        (trivia:match (store feed stream-provider)

+          ((list title path)

            (log-serialization t feed path)

-           (make-feed-reference url :title title :path (feed-relative-pathname path))))))))

-

-(defun feed-index (index-stream pull-time references)

-  (yason:with-output (index-stream :indent t)

-    (yason:encode-object

-     (make-feed-index pull-time (remove-if 'null references)))))

+           (make-feed-reference (alimenta:feed-link feed)

+                                :title title

+                                :path (feed-relative-pathname

+                                       (uiop:pathname-directory-pathname

+                                        (merge-pathnames path

+                                                         (stream-provider:root stream-provider)))))))))))

 (defun archive-feeds (pull-time pull-directory index-stream)

-  (let ((references (pull-and-store-feeds *feeds* pull-directory)))

-    (feed-index index-stream pull-time references)

-    references))

+  (prog1-bind (references (mapcar (op (pull-and-store-feed _ pull-directory))

+                                  *feeds*))

+    (feed-index index-stream pull-time references)))

 (defun archive-feeds-nondeterm ()

   (let* ((pull-time (local-time:now))

 	 (pull-directory (get-store-directory-name pull-time)) 

-	 (index-path (merge-pathnames "index.json" pull-directory)))

+	 (index-path (merge-pathnames "index.json" pull-directory))

+         (feed-stream-provider (make-instance 'alimenta.feed-archive.encoders:feed-stream-provider

+                                              :if-exists :error

+                                              :root pull-directory)))

     (with-open-file (index index-path :direction :output)

-      (archive-feeds pull-time pull-directory index))

+      (archive-feeds pull-time

+                     feed-stream-provider

+                     index))

     (format t "~&!! pull-directory ~a~%" (uiop:enough-pathname pull-directory *feed-base*))))

 ;; This is an ungodly mess, we need to avoid funneling everything through fix-pathname-or-skip

@@ -1,23 +1,25 @@

+(in-package :alimenta.feed-archive.encoders)

+

 (defmethod yason:encode ((object pathname) &optional stream)

   (yason:encode (princ-to-string (uiop:native-namestring object))

-		       stream)

+                       stream)

   object)

 (defmethod yason:encode ((object puri:uri) &optional stream)

   (yason:encode (puri:render-uri object nil)

-		stream)

+                stream)

   object)

 (defmethod yason:encode-slots progn ((feed alimenta:feed))

   (with-accessors ((description alimenta:description)

-		   (feed-link alimenta:feed-link)

-		   (items alimenta:items)

-		   (link alimenta:link)

-		   (source-type alimenta:source-type)

-		   (title alimenta:title)) feed

+                   (feed-link alimenta:feed-link)

+                   (items alimenta:items)

+                   (link alimenta:link)

+                   (source-type alimenta:source-type)

+                   (title alimenta:title)) feed

     (yason:encode-object-element "title" title)

     (yason:encode-object-element "fetch-url"

-				 (puri:render-uri feed-link nil))

+                                 (puri:render-uri feed-link nil))

     (yason:encode-object-element "link" link)

     ;;(yason:encode-object-element "source-type" source-type)

     (yason:encode-object-element "description" description))

@@ -30,11 +32,11 @@

 (defmethod yason:encode-slots progn ((item alimenta:item))

   (with-accessors ((author alimenta:author)

-		   (content alimenta:content)

-		   (date alimenta:date)

-		   (id alimenta:id)

-		   (link alimenta:link)

-		   (title alimenta:title)) item

+                   (content alimenta:content)

+                   (date alimenta:date)

+                   (id alimenta:id)

+                   (link alimenta:link)

+                   (title alimenta:title)) item

     (let* ((date (local-time:format-timestring nil date)))

       (yason:with-object ()

 	(yason:encode-object-element "title" title)

@@ -49,3 +51,20 @@

     (yason:encode-slots item))

   item)

+

+(defun encode-collection-object (other-pairs collection-key collection-value element-encoder)

+  (yason:with-object ()

+    (loop for (key value) on other-pairs by #'cddr

+       do

+         (yason:encode-object-element key value))

+    (yason:with-object-element (collection-key)

+      (yason:with-array ()

+        (dolist (item collection-value)

+          (funcall element-encoder item))))))

+

+(defmacro with-collection ((item-sym key collection &rest other-pairs) &body encoder)

+  (once-only (key collection)

+    `(encode-collection-object (list ,@other-pairs)

+                               ,key ,collection

+                               (lambda (,item-sym)

+                                 ,@encoder))))