88 lines
2.4 KiB
Racket
88 lines
2.4 KiB
Racket
#lang racket/base
|
|
|
|
(require "git-provider.rkt"
|
|
racket/string
|
|
)
|
|
|
|
(provide cmd-git-status
|
|
cmd-git-add
|
|
cmd-git-commit
|
|
)
|
|
|
|
|
|
(define (check-arg 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))
|
|
|
|
(define (cmd-git-status args)
|
|
(let ((output (run-git '(status -s))))
|
|
(let-values (((result out) (git-out 'status output)))
|
|
(if result
|
|
(map (λ (line)
|
|
(let* ((state (string->symbol (string-trim (substring line 0 2))))
|
|
(file (string-trim (substring line 3))))
|
|
(cond
|
|
([eq? state '??] (list 'new file))
|
|
([eq? state 'M] (list 'modified file))
|
|
([eq? state 'A] (list 'added file))
|
|
([eq? state 'D] (list 'deleted file))
|
|
([eq? state 'AM] (list 'modified file))
|
|
([eq? state 'AD] (list 'deleted file))
|
|
([eq? state 'MM] (list 'modified file))
|
|
([eq? state 'MD] (list 'deleted file))
|
|
(else
|
|
(git-error 'status "Unexpected state" state))
|
|
)
|
|
))
|
|
out)
|
|
(git-error 'status "Error" out)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|
|
|
|
(define-syntax def-proxy-cmd
|
|
(syntax-rules ()
|
|
((_ f cmd)
|
|
(def-proxy-cmd f cmd (λ args (begin #t))))
|
|
((_ f cmd code)
|
|
(define (f args)
|
|
(code args)
|
|
(let ((output (run-git (cons 'cmd args))))
|
|
(let-values (((result out) (git-out 'cmd output)))
|
|
(if result
|
|
(begin
|
|
(git-displ out)
|
|
result)
|
|
(git-error 'cmd "Error" out)))))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(def-proxy-cmd cmd-git-add add)
|
|
(def-proxy-cmd cmd-git-commit commit
|
|
(λ (args) (check-arg 'commit args '((-m 1 "A commit message is mandatory"))))
|
|
)
|
|
|