(in-package :alimenta.feed-archive.tools)

(defgeneric store (item directory)
  (:documentation "Store an item in a directory"))

(defmacro -> (&rest forms)
  (let ((forms (mapcar (lambda (form)
			 (typecase form
			   (list form)
			   (t (list form))))
		       forms)))
    (loop with result = (car forms)
       for form in (cdr forms)
       do
	 (setf result `(,(car form)
			 ,result
			 ,@(cdr form)))
       finally
	 (return result))))

(defun fix-pathname ()
  (let ((restart (find-restart 'fix-pathname)))
    (when restart
      (invoke-restart restart))))

(defun sha256-string (string)
  (let* ((digester (ironclad:make-digesting-stream :sha256))
	 (digest-stream (flexi-streams:make-flexi-stream digester)))
    (princ string digest-stream)
    (crypto:byte-array-to-hex-string
     (crypto:produce-digest
      digester))))

(defgeneric get-id (feed)
  (:documentation "Get an identifier for a feed"))

(defmethod get-id ((feed alimenta:feed))
  (let* ((link (alimenta:feed-link feed))
	 (host (puri:uri-host link)))
    (concat host "-" (sha256-string link) "/")))

(defmethod get-id ((item alimenta:item))
  (concatenate 'string
	       (local-time:format-timestring nil (alimenta:date item))
	       "-"
	       (sha256-string (alimenta:id item))))

(defun older-than-a-month (date)
  (let ((month-ago (local-time:timestamp- (local-time:now)
					  31 :day)))
    (if date
        (local-time:timestamp< date month-ago)
        t)))

(defun older-than-a-week (date)
  (let ((week-ago (local-time:timestamp- (local-time:now)
                                         7 :day)))
    (local-time:timestamp< date week-ago)))

(defmacro restart-once ((restart-name (&rest restart-args) &body handler) &body body)
  "Defines a restart that, the first time it's executed, runs a chunk of code and then,
next time, it re-raises the exception."
  (with-gensyms (start restarted)
    `(let ((,restarted nil))
       (tagbody ,start
	        (restart-case
	            (progn ,@body)
	          (,restart-name ,restart-args
	            ,@handler
	            (unless ,restarted
		            (setf ,restarted t)
		            (go ,start))))))))


(defun relative-uri-p (uri)
  (let ((uri (fw.lu:may (puri:uri uri))))
    (and uri
         (not
          (and (puri:uri-scheme uri)
               (puri:uri-host uri)
               t)))))

(defun coerce-feed-link (link feed)
  (flet ((unrelativize (url)
           (puri:render-uri (puri:merge-uris url
                                             link)
                            nil)))
    (prog1 feed
      (unless (and (alimenta:feed-link feed)
                   (not (relative-uri-p (alimenta:feed-link feed))))
        (setf (alimenta:feed-link feed)
              (if (alimenta:feed-link feed)
                  (unrelativize (alimenta:feed-link feed))
                  link)))
      (when (relative-uri-p (alimenta:link feed))
        (setf (alimenta:link feed)
              (unrelativize (alimenta:link feed)))))))

(defmacro with-retry ((&optional (message "retry the operation")) &body body)
  `(loop
     (restart-case (return (progn ,@body))
	     (retry ()
	       :report (lambda (s)
		               (format s "~@<~a~@:>" ,message))))))