(in-package :alimenta.feed-archive)
 
 (defvar *feeds*)
 (defvar *feed-base*)
 
 (defparameter +dirname-format+
   '((:year 4) #\- (:month 2) #\- (:day 2) #\/ (:hour 2) #\- (:min 2) #\/))
 

 (defmacro lambda* ((&rest args) &body body)
   (let ((rest-arg (gensym "REST")))
     `(lambda (,@args &rest ,rest-arg)
        (declare (ignore ,rest-arg))
        ,@body)))
 

 (defun safe-pull-feed (feed-url &aux (pop-times 0))

   "Handles date parsing errors in the feed: chronicity won't parse
    certain date formats, this catches the error and modifies the
    format to something chronicity can handle."

   (handler-bind ((warning #'muffle-warning)
                  (error (lambda* (c)
                           (when (find-restart 'alimenta:pop-token c)
                             (cond
                               ((< pop-times 50)
                                (incf pop-times)
                                (format t
                                        "~&Processing error, trying to pop a token (popped ~d times)~%"
                                        pop-times)
                                (alimenta:pop-token))
                               (t
                                (continue)))))))
     (prog1-bind (feed (alimenta.pull-feed:pull-feed feed-url))
       ;; Why am I decf-ing here?
       (alimenta:transform feed

                           (lambda (entity)
                             (typecase entity
                               (alimenta:item

                                (let ((v (alimenta:content entity)))
                                  (when v
                                    (setf (alimenta:content entity)

                                          (html-sanitizer:sanitize v))))))))

       (decf pop-times))))

 (defmacro with-progress-message ((stream before after &optional (error-msg " ERROR~%~4t~a~%")) &body body)
   (once-only (before after stream)
     `(handler-bind ((error (op (format ,stream ,error-msg _))))
        (format ,stream "~&~a . . ." ,before)
        (multiple-value-prog1 (progn

                                ,@body)
          (format ,stream " ~a~%" ,after)))))

 (defun skip-feed (c)
   (when-let ((restart (find-restart 'skip-feed c)))

     (invoke-restart restart)))

 (defun save-feed (feed output-file &key (if-exists :supersede))
   (with-output-to-file (s output-file :if-exists if-exists)
     (plump:serialize (alimenta:doc feed) s)))
 

 (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")
       (funcall feed-puller feed-url))))
 
 (defun normalize-feed (feed-url feed)
   (alimenta:filter-feed (coerce-feed-link feed-url feed)
                         (complement #'older-than-a-month)
                         :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 at ~a" feed-url path))

     (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 feed-index (index-stream pull-time references)
   (yason:with-output (index-stream :indent t)
     (yason:encode-object

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

 (defvar *error-client* nil)
 (defgeneric record-error (client url)
   (:method ((client null) feed-url)))
 

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

   (declare (optimize (debug 3)))

   (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

                               (stream-provider:absolute-path stream-provider path))))

     (handler-bind ((cl+ssl:ssl-error-verify

                      (lambda (c)
                        (declare (ignore c))
                        (format *error-output* "~&SSL Error while pulling ~a~%"
                                feed-url))))

       (restart-case

           (let* ((feed (with-retry ("Pull feed again.")
                          (normalize-feed feed-url (log-pull t)))))
             (trivia:match (store feed stream-provider)
               ((list title path)
                (log-serialization t feed path)
                (make-feed-reference (alimenta:feed-link feed)
                                     :title title
                                     :path (feed-relative-pathname

                                            (stream-provider:absolute-path stream-provider path))))))

         (skip-feed ()
           :report (lambda (s)
                     (format s "Stop processing for ~a" feed-url))
           (record-error *error-client* feed-url))))))

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

   (prog1-bind (references (mapcar (op (pull-and-store-feed _ pull-directory))
                                   *feeds*))
     (feed-index index-stream pull-time references)))

 (defpackage :alimenta.feed-archive/tests
   (:use :cl :should-test)
   (:export ))
 (in-package :alimenta.feed-archive/tests)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (import 'alimenta.feed-archive::feed-index))
 
 (defun hash-table= (ht1 ht2 &key (key-test 'equal) (value-test 'equal))
   (let ((ht1-keys (alexandria:hash-table-keys ht1))
         (ht2-keys (alexandria:hash-table-keys ht2)))
     (and (= (length ht1-keys)
             (length ht2-keys))
          (every key-test ht1-keys ht2-keys)
          (every value-test
                 (alexandria:hash-table-values ht1)
                 (alexandria:hash-table-values ht2)))))
 
 (deftest feed-index ()

   (should be hash-table=
           (yason:parse
            (with-output-to-string (s)
              (feed-index s (local-time:encode-timestamp 0 0 0 0 1 1 1) '()))
            :object-as :hash-table :json-arrays-as-vectors nil)
           (alexandria:alist-hash-table
            '(("pull-time" . "0001-01-01T00:00:00.000000-08:00")
              ("feeds" . ())))))