git.fiddlerwoaroof.com
encoders.lisp
f7e44666
 (in-package :alimenta.feed-archive.encoders)
 
 (defun fix-path (path)
   ;; Work around some issue with pathnames
   (setf path (merge-pathnames path (make-pathname :type :unspecific))))
 
 (defun skip-item ()
   (when-let ((restart (find-restart 'skip-item)))
     (invoke-restart restart)))
 
f92f94ff
 (define-condition feed-error (error)
   ((%feed :reader the-feed :initarg :feed :initform (error "We need a feed"))
    (%condition :reader the-condition :initarg :condition :initform (error "feed-error must wrap a condition"))))
 
 (defun wrap-condition (condition feed)
   (error 'feed-error
114a2b3d
          :feed feed
          :condition condition))
f92f94ff
 
36fc9de2
 (defmacro unwrap-feed-errors (() &body body)
   `(handler-bind ((feed-error (op (error (the-condition _)))))
      ,@body))
 
114a2b3d
 (defun %encode-item (root-dir item)
   (destructuring-bind (title path) item
     (format t "~&Encoding ~a~%" title)
     (restart-once (fix-pathname () (fix-path path))
       (let ((pathname (uiop:enough-pathname path root-dir)))
         (yason:with-object ()
           (yason:encode-object-element "title" title)
           (yason:encode-object-element "path" pathname))))))
 
f7e44666
 (defun %encode-feed-as-json (feed item-storage-info root-dir &optional stream)
   (with-accessors ((description alimenta:description)
114a2b3d
                    (feed-link alimenta:feed-link)
                    (items alimenta:items)
                    (link alimenta:link)
                    (source-type alimenta:source-type)
e3a39cd6
                    (title alimenta:title)) feed
     (yason:with-output (stream :indent t)
       (yason:with-object ()
         (yason:encode-object-element "metadata" feed)
         (yason:with-object-element ("items")
           (yason:with-array ()
             (dolist (item item-storage-info)
               (with-simple-restart (skip-item "Skip item ~s" (car item))
                 ;; (format t "~&I Store Info: ~a~%~4t~a~%" (uiop:unix-namestring (cadr item)) root-dir)
                 (%encode-item root-dir item)
                 #+null
                 (yason:encode-array-element (uiop:unix-namestring (uiop:enough-pathname root-dir (cadr item))))
                 ))))))))
f7e44666
 
114a2b3d
 (defmethod store ((items sequence) storage)
   (when (next-method-p)
     (format t "calling next...~%")
     (call-next-method))
   (map 'list (op (store _ storage))
36fc9de2
        (stable-sort (sort items #'string-lessp
114a2b3d
                           :key #'alimenta:title)
                     #'local-time:timestamp>
                     :key #'alimenta:date)))
f7e44666
 
 (defmethod store ((feed alimenta:feed) (directory pathname))
   (flet ((get-feed-store-name (feed directory)
114a2b3d
            (merge-pathnames (get-id feed)
                             directory)))
f7e44666
 
     (with-accessors ((description alimenta:description)
114a2b3d
                      (feed-link alimenta:feed-link)
                      (items alimenta:items)
                      (link alimenta:link)
                      (source-type alimenta:source-type)
                      (title alimenta:title)) feed
                                         ; We wrap all errors with our own condition
f7e44666
       (handler-bind ((error (lambda (c) (error 'feed-error :feed feed :condition c))))
e3a39cd6
         (values (multiple-value-list
                  (prog1-let ((feed-title title)
                              (feed-store (get-feed-store-name feed directory)))
                    (ensure-directories-exist feed-store)
                    (with-open-file (index (merge-pathnames "index.json" feed-store) :direction :output)
                      (%encode-feed-as-json feed
                                            (store (copy-seq items) feed-store)
                                            feed-store
                                            index))))
114a2b3d
                 feed-link)))))
f7e44666
 
f92f94ff
 (defmethod store ((feed alimenta:feed) (stream stream))
   (handler-bind ((error (lambda (c)
114a2b3d
                           (typecase c
                             (feed-error c)
                             (t (wrap-condition c feed))))))
f92f94ff
     (yason:with-output (stream :indent t)
       (yason:with-object ()
114a2b3d
         (yason:with-object-element ("metadata")
           (yason:encode-object feed))
         (yason:with-object-element ("items")
           (yason:with-array ()
             (for:for ((item over feed))
               (store item stream))))))
     (list (alimenta:title feed)
           stream)))
f92f94ff
 
 (defmethod store ((item alimenta:item) (directory pathname))
   (flet ((get-item-store-name (item directory)
114a2b3d
            (let ((id (get-id item)))
              (merge-pathnames (make-pathname :name id :version nil :type "json") directory))))
f92f94ff
 
e3a39cd6
     (multiple-value-list
      (prog1-let ((item-title (alimenta:title item))
                  (fn (get-item-store-name item directory)))
        (with-open-file (item-f fn :direction :output)
          (yason:encode item item-f))))))
f92f94ff
 
 (defmethod store ((item alimenta:item) (stream stream))
   (yason:with-output (stream :indent t)
e3a39cd6
     (yason:with-object ()
       (yason:encode-slots item)))
114a2b3d
   (list (alimenta:title item)
         stream))
 
 ;; The feed is always index.json
 (defmethod stream-provider:stream-key (provider (feed alimenta:feed))
   (pathname
    (string-join
     (list (get-id feed)
           "index.json")
     "/")))
 
 (defmethod stream-provider:stream-key :around ((provider stream-provider:file-provider)
                                                (feed alimenta:feed))
   (prog1-bind (result (call-next-method))
     (ensure-directories-exist (merge-pathnames result
                                                (stream-provider:root provider)))))
 
 (defmethod stream-provider:stream-key (provider (item alimenta:item))
   (let ((id (get-id item)))
     (make-pathname :name id :version nil :type "json")))
f7e44666
 
e3a39cd6
 (defclass feed-stream-item-provider ()
114a2b3d
   ((%item-providers :accessor item-providers :initform (make-hash-table :test 'equal))))
 
e3a39cd6
 (defclass feed-stream-provider (stream-provider:file-provider feed-stream-item-provider)
   ())
 
 (defclass feed-stream-string-provider (stream-provider:string-provider feed-stream-item-provider)
   ())
 
114a2b3d
 (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)))
     (ensure-gethash items-root
                     (item-providers provider)
                     (make-instance 'stream-provider:file-provider :root items-root))))
 
 (defmethod store :around ((item alimenta:feed-entity) (stream-provider stream-provider:stream-provider))
   (call-next-method)
   (list (alimenta:title item)
         (stream-provider:stream-key stream-provider item)))
 
 (defmethod store ((item alimenta:item) (stream-provider stream-provider:stream-provider))
   (stream-provider:with-storage-stream (s item stream-provider)
     (store item s)))
 
d28d3987
 (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))
 
114a2b3d
 (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)
                      (feed-link alimenta:feed-link)
                      (items alimenta:items)
                      (link alimenta:link)
                      (source-type alimenta:source-type)
                      (title alimenta:title)) feed
       (let* ((item-provider (stream-provider:get-nested-provider stream-provider feed))
d28d3987
              (item-storage-info (map-coalesce (op (store _ item-provider))
                                               items)))
e3a39cd6
         (let ((yason::*json-output*
                 (make-instance 'yason::json-output-stream
                                :output-stream s
                                :indent t)))
d28d3987
           (with-collection (item "items" item-storage-info "metadata" feed)
             (destructuring-bind (title path) item
               (yason:with-object ()
e3a39cd6
                 (yason:encode-object-elements "title" title "path" path)))))))))