(defpackage :zfs-cleaner.utils
   (:use :cl)
   (:export #:regex-match #:include #:exclude #:pick
            #:snapshot-to-vector #:vector-to-lt #:key-transform
            #:combine #:derive #:cumsum #:over #:on #:shortcut
            #:defun-ct))
 (in-package :zfs-cleaner.utils)
 
 (defmacro shortcut (name function &body bound-args)
   `(eval-when (:load-toplevel :compile-toplevel :execute)
      (setf (fdefinition ',name)
            (,function ,@bound-args))))
 
 (defmacro defun-ct (name (&rest args) &body body)
   `(eval-when (:load-toplevel :compile-toplevel :execute)
      (defun ,name ,args
        ,@body)))
 
 (defun-ct regex-match (regex)
   (lambda (data)
     (cl-ppcre:scan-to-strings regex data)))
 
 (defun-ct include (pred)
   (lambda (seq)
     (remove-if-not pred seq)))
 
 (defun-ct exclude (pred)
   (lambda (seq)
     (remove-if pred seq)))
 
 (defun-ct pick (selector)
   (lambda (seq)
     (map 'list selector seq)))
 
 (defun-ct key-transform (fun key-get key-set)
   (lambda (it)
     (let ((key-val (funcall key-get it)))
       (funcall key-set
                (funcall fun key-val)))))
 
 (defun-ct combine (fun1 fun2)
   (lambda (item)
     (list (funcall fun1 item)
           (funcall fun2 item))))
 
 (defun-ct derive (diff-fun &key (key #'identity))
   (lambda (list)
     (mapcar (lambda (next cur)
               (cons (funcall diff-fun (funcall key next) (funcall key  cur))
                     next))
             (cdr list)
             list)))
 
 (defun-ct cumsum (&key (add-fun #'+) (key #'identity) (combine (lambda (x y) y x)) (zero 0))
   (lambda (seq)
     (nreverse
      (reduce (lambda (accum next)
                (let ((key-val (funcall key next))
                      (old-val (if accum
                                   (funcall key (car accum))
                                   zero)))
                  (cons (funcall combine
                                 (funcall add-fun old-val key-val)
                                 next)
                        accum)))
              seq
              :initial-value ()))))
 
 (defun-ct over (fun &key (result-type 'list))
   (lambda (seq)
     (map result-type fun seq)))
 
 (defun-ct on (fun key)
   (lambda (it)
     (funcall fun (funcall key it))))
 
 (defpackage :zfs-cleaner
   (:use :cl :zfs-cleaner.utils))
 (in-package :zfs-cleaner)
 
 (defgeneric %get-snapshots (env)
   (:method ((env (eql :dev)))
     (alexandria:read-file-into-string #p "/tmp/feeds"))
   (:method ((env (eql :prod)))
     (with-output-to-string (s)
       (uiop:run-program "zfs list -r -t snapshot -H -p tank/feed_archive/feeds"
                         :output s))))
 
 (defun get-snapshots (&optional (env :dev))
   (%get-snapshots env))
 
 (shortcut find-date regex-match
   '(:group
     (:named-register "year" (:greedy-repetition 4 4 :digit-class)) #\-
     (:named-register "month" (:greedy-repetition 2 2 :digit-class)) #\-
     (:named-register "day" (:greedy-repetition 2 2 :digit-class)) #\-
     (:named-register "hour" (:greedy-repetition 2 2 :digit-class)) #\-
     (:named-register "minute" (:greedy-repetition 2 2 :digit-class))))
 
 (defun-ct snapshot-to-vector (name)
   (map 'vector #'parse-integer
        (nth-value 1 (find-date name))))
 
 (defun-ct vector-to-lt (vec)
   (apply 'local-time:encode-timestamp
          0 0
          (coerce (reverse vec)
                  'list)))
 
 (defstruct (zfs-date (:type vector))
   year month day hour minute)
 
 (defparameter +date-format+
   '((:year 4) #\-
     (:month 2) #\-
     (:day 2) #\-
     (:hour 2) #\-
     (:min 2)))
 
 (defun get-snapshots-to-prune (snapshots)
   (labels ((first-column (it)
              (elt (fwoar.string-utils:split #\tab it)
                   0))
            (is-saved-snapshot (ts)
              (or (is-hourly-snapshot ts)
                  (not (is-stale ts))))
            (is-hourly-snapshot (it)
              (= (local-time:timestamp-minute it)
                 0))
            (is-stale (item)
              (local-time:timestamp< item
                                     (local-time:timestamp- (local-time:now)
                                                            2 :day))))
     (funcall (alexandria:compose (pick #'second)
                                  (exclude (alexandria:compose (on #'is-saved-snapshot #'first)))
                                  (over (combine (alexandria:compose #'vector-to-lt
                                                                     #'snapshot-to-vector)
                                                 #'first-column))
                                  (include 'find-date))
              (fwoar.string-utils:split #\newline snapshots))))
 
 (defun dev-main ()
   (let ((snapshots (get-snapshots :dev)))
     (format t "~&~{~a~%~}" (get-snapshots-to-prune snapshots))))
 
 (defun prod-main ()
   (let ((snapshots (get-snapshots :prod)))
     (format t "~&~{~a~%~}" (get-snapshots-to-prune snapshots))))