92 lines
2.8 KiB
Scheme
Executable file
92 lines
2.8 KiB
Scheme
Executable file
#!/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")))
|