#!/usr/bin/guile \
--no-auto-compile -e main -s
!#

(use-modules (ice-9 format)
             (ice-9 rdelim)
             (srfi srfi-1)
             (srfi srfi-26))

(define (read-lines port)
  (let loop ((data (read-line port)) (accum '()))
    (if (eof-object? data)
        (reverse accum)
        (loop (read-line port) (cons data accum)))))

(define (remove-dlq-definition data)
  (define (find-dlq-start data)
    (let loop ((data data) (n 0))
      (if (null? data)
          #f
          (let ((line (car data)))
            (if (string-contains line "dlq =")
                n
                (loop (cdr data) (1+ n)))))))
  (define (find-dlq-end data dlq-start)
    (let loop ((data (drop data dlq-start)) (n dlq-start))
      (if (null? data)
          #f
          (let ((line (car data)))
            (if (string=? ")" (string-trim-both line))
                n
                (loop (cdr data) (1+ n)))))))
  (let* ((dlq-start (find-dlq-start data))
         (dlq-end (and dlq-start (find-dlq-end data dlq-start))))
    (if (and dlq-start dlq-end)
        (append (take data dlq-start) (drop data (1+ dlq-end)))
        data)))

(define (remove-dlq-tags data)
  (remove (cut string-contains <> "Tags.of(dlq)") data))

(define (remove-dlq-usage data)
  (remove (cut string-contains <> "dead_letter_queue=dlq,") data))

(define (remove-dlq-enabled data)
  (remove (cut string-contains <> "dead_letter_queue_enabled=True,") data))

(define-syntax ->
  (syntax-rules ()
    ((_ a) a)
    ((_ a (b c ...)) (b a c ...))
    ((_ a b) (b a))
    ((_ a b c) (-> (-> a b) c))
    ((_ a b ... c) (-> (-> a b ...) c))))

(define (remove-dlq filename)
  (let* ((data (call-with-input-file filename read-lines))
         (data' (-> data
                    remove-dlq-definition
                    remove-dlq-tags
                    remove-dlq-usage
                    remove-dlq-enabled)))
    (when (not (equal? data data'))
      (call-with-output-file filename
        (lambda (port)
          (for-each (cut write-line <> port) data'))))))

(define (yes-no-prompt message)
  (display (string-append message " "))
  (let ((response (string-downcase (read-line))))
    (cond
     ((string=? response "y") #t)
     ((string=? response "n") #f)
     (else (display "Please answer y or n")
           (newline)
           (yes-no-prompt message)))))

(define (run cmd . args)
  (let ((rc (apply system* cmd args)))
    (unless (zero? (status:exit-val rc))
      (error (format #f "~a failed with exit code ~a" cmd (status:exit-val rc))))))

(define (main args)
  (run "git" "fetch" "--prune")
  (run "git" "checkout" "master")
  (run "git" "pull")
  (remove-dlq "cloud.py")
  (run "git" "diff")
  (when (yes-no-prompt "Commit changes?")
    (run "git" "checkout" "-b" "remove-dlq")
    (run "git" "add" "cloud.py")
    (run "git" "commit" "-m" "Update: remove dead-letter queue")))