76 lines
2.0 KiB
Racket
76 lines
2.0 KiB
Racket
#lang racket/base
|
|
|
|
(require "git-provider.rkt"
|
|
racket/string
|
|
)
|
|
|
|
(provide def-git-cmd-proxy
|
|
check-git-args
|
|
has-git-arg?
|
|
std-process-git-result
|
|
)
|
|
|
|
|
|
(define (has-git-arg? args opt)
|
|
(if (list? args)
|
|
(if (null? args)
|
|
#f
|
|
(if (symbol? opt)
|
|
(if (or (eq? (car args) opt)
|
|
(and (string? (car args))
|
|
(string=? (car args) (symbol->string opt))))
|
|
#t
|
|
(has-git-arg? (cdr args) opt))
|
|
(error 'has-git-arg? "opt must be of type symbol?")))
|
|
(error 'has-git-arg? "args must be a list of arguments")
|
|
)
|
|
)
|
|
|
|
(define (check-git-args cmd args flags)
|
|
(for-each
|
|
(λ (opt)
|
|
(let ((flag (car opt))
|
|
(num-args (cadr opt))
|
|
(err-msg (caddr opt)))
|
|
(letrec ((find (λ (l)
|
|
(if (null? l)
|
|
#f
|
|
(if (eq? (car l) flag)
|
|
(if (>= (length (cdr l)) num-args)
|
|
#t
|
|
#f)
|
|
(find (cdr l)))))))
|
|
(let ((found (find args)))
|
|
(unless found
|
|
(error 'git (format "git ~a: ~a" cmd err-msg))))
|
|
)
|
|
))
|
|
flags)
|
|
args)
|
|
|
|
|
|
(define (std-process-git-result cmd result output out)
|
|
(displayln output)
|
|
(git-displ out)
|
|
(if result
|
|
result
|
|
(git-error cmd "Error" out)))
|
|
|
|
(define-syntax def-git-cmd-proxy
|
|
(syntax-rules ()
|
|
((_ f cmd)
|
|
(def-proxy-cmd f cmd (λ args t) standard-result))
|
|
((_ f cmd pre-code)
|
|
(def-proxy-cmd f cmd pre-code standard-result))
|
|
((_ f cmd pre-code process-result)
|
|
(define (f args)
|
|
(let ((nargs (pre-code args)))
|
|
(let ((output (run-git (cons cmd nargs))))
|
|
(let-values (((result out) (git-out cmd output)))
|
|
(process-result cmd result output out))))))
|
|
)
|
|
)
|
|
|
|
|
|
|