90 lines
2.7 KiB
Racket
90 lines
2.7 KiB
Racket
#lang racket/base
|
|
|
|
(require "private/git-provider.rkt"
|
|
"private/git-commands.rkt"
|
|
"private/config.rkt"
|
|
simple-log
|
|
racket/string
|
|
)
|
|
|
|
(provide git
|
|
git-add
|
|
git-status
|
|
git-commit
|
|
git-pull
|
|
git-push
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided commands
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define git-commands (make-hash))
|
|
|
|
(define-syntax git
|
|
(syntax-rules ()
|
|
((_ command b1 ...)
|
|
((hash-ref git-commands command
|
|
(λ ()
|
|
(error "Not a supported or recognized git command: " command)))
|
|
(list b1 ...)))
|
|
)
|
|
)
|
|
|
|
(define (add-porcelain args . f)
|
|
(if (has-git-arg? args '--porcelain)
|
|
(if (null? f) args ((car f) args))
|
|
(if (null? f) (cons '--porcelain args)
|
|
((car f) (cons '--porcelain args)))))
|
|
|
|
(define-syntax def-cmd
|
|
(syntax-rules ()
|
|
((_ cmd cmd* cmd-sym)
|
|
(def-cmd cmd cmd* cmd-sym (λ (args) args) std-process-git-result))
|
|
((_ cmd cmd* cmd-sym pre-code)
|
|
(def-cmd cmd cmd* cmd-sym pre-code std-process-git-result))
|
|
((_ cmd cmd* cmd-sym pre-code process-result)
|
|
(begin
|
|
(def-git-cmd-proxy cmd* cmd-sym
|
|
pre-code
|
|
process-result)
|
|
(define (cmd . args) (cmd* args))
|
|
(hash-set! git-commands cmd-sym cmd*)))
|
|
)
|
|
)
|
|
|
|
(def-cmd git-status cmd-git-status 'status
|
|
(λ (args) (if (has-git-arg? args '-s)
|
|
args
|
|
(cons '-s args)))
|
|
(λ (cmd result output out)
|
|
(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" output)))
|
|
)
|
|
|
|
|
|
(def-cmd git-add cmd-git-add 'add)
|
|
(def-cmd git-commit cmd-git-commit 'commit
|
|
(λ (args) (check-git-args 'commit args '((-m 1 "A commit message is mandatory"))))
|
|
)
|
|
(def-cmd git-push cmd-git-push 'push add-porcelain)
|
|
(def-cmd git-pull cmd-git-pull 'pull)
|
|
(def-cmd git-branch cmd-git-branch 'branch)
|