From c556b4f45286d64d378649b563a0bd1c9385da76 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 13 Aug 2026 00:28:09 +0200 Subject: [PATCH] Version functionality added. --- info.rkt | 46 +++++++++++++-------------- main.rkt | 24 ++++++++++++++ private/info.rkt | 81 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 128 insertions(+), 23 deletions(-) create mode 100644 private/info.rkt diff --git a/info.rkt b/info.rkt index 29f6434..e8b5bac 100644 --- a/info.rkt +++ b/info.rkt @@ -1,23 +1,23 @@ -#lang info - -(define collection "git-cli") -(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") -(define version "0.3.7") -(define pkg-authors '("Hans Dijkema")) -(define license 'MIT) - -(define deps - '("base" - "simple-ini" - "simple-log" - "racket-index" - "scribble-lib" - "racket-makefile" - "package-zipper")) - -(define build-deps - '("rackunit-lib" - "racket-doc")) - -(define scribblings - '(("scribblings/git.scrbl" () ("Git")))) +#lang info + +(define collection "git-cli") +(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") +(define version "0.3.9") +(define pkg-authors '("Hans Dijkema")) +(define license 'MIT) + +(define deps + '("base" + "simple-ini" + "simple-log" + "racket-index" + "scribble-lib" + "racket-makefile" + "package-zipper")) + +(define build-deps + '("rackunit-lib" + "racket-doc")) + +(define scribblings + '(("scribblings/git.scrbl" () ("Git")))) \ No newline at end of file diff --git a/main.rkt b/main.rkt index 281b825..f00d5a3 100644 --- a/main.rkt +++ b/main.rkt @@ -4,6 +4,7 @@ "private/git-commands.rkt" "private/config.rkt" "private/diff.rkt" + "private/info.rkt" simple-log racket/string net/sendurl @@ -17,6 +18,7 @@ git-push git-log git-grep + git-new-version ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -25,6 +27,7 @@ (define git-commands (make-hash)) + (define-syntax git (syntax-rules () ((_ command b1 ...) @@ -48,6 +51,7 @@ (g args) (g (cons '--porcelain args))))) + (define-syntax def-cmd (syntax-rules () ((_ cmd cmd* cmd-sym) @@ -117,6 +121,26 @@ (def-cmd git-log cmd-git-log 'log) (def-cmd git-rev-list cmd-git-rev-list 'rev-list) +(define (git-version . args) + (cmd-git-version args)) + +(define (cmd-git-version args) + (info-version ".")) + +(hash-set! git-commands 'version cmd-git-version) + +(define (git-new-version . args) + (cmd-git-new-version args)) + +(define (cmd-git-new-version args) + (when(null? args) + (error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch")) + (let ((kind (car args))) + (git-next-version kind ".") + (git-version))) + +(hash-set! git-commands 'new-version cmd-git-new-version) + (def-cmd git-diff cmd-git-diff 'diff (λ (args info) args) (λ (cmd exit-code result output out info) diff --git a/private/info.rkt b/private/info.rkt new file mode 100644 index 0000000..1f0ef33 --- /dev/null +++ b/private/info.rkt @@ -0,0 +1,81 @@ +#lang racket/base + +(require setup/getinfo + racket/string + ) + +(provide info-version + set-info-version! + git-next-version + ) + +(define (info-version dir) + (let* ((l (get-info/full dir)) + (re #px"([0-9]+)[.]([0-9]+)([.]([0-9]+))?") + (v (with-handlers ([exn:fail? + (λ (e) "0.1")]) + (l 'version))) + (m (regexp-match re v)) + ) + (map string->number + (list (cadr m) (caddr m) (if (eq? (cadddr (cdr m)) #f) + "0" + (cadddr (cdr m))))) + )) + +(define (set-info-version! dir maj min patch) + + (define (write-version fh) + (let ((str (if (= patch 0) + (format "(define version \"~a.~a\")" maj min) + (format "(define version \"~a.~a.~a\")" maj min patch)))) + (unless (eq? fh #f) + (displayln str fh)) + str)) + + (let ((info-file (build-path dir "info.rkt"))) + (unless (file-exists? info-file) + (error (format "No info.rkt exists at ~a" info-file))) + + (let ((fh (open-input-file info-file))) + (letrec ((reader (λ () + (let ((line (read-line fh))) + (if (eof-object? line) + '() + (cons line (reader))))))) + (let* ((text (string-join (reader) "\n"))) + (close-input-port fh) + (let* ((re #px"[(]define\\s+version\\s+[\"][^\"]+[\"]\\s*[)]") + (ntext (regexp-replace re text (write-version #f))) + (fout (open-output-file info-file #:exists 'replace)) + ) + (display ntext fout) + (close-output-port fout) + #t))))) + ) + +(define (git-next-version kind . dir*) + (let ((dir (if (null? dir*) + "." + (car dir*)))) + (if (memq kind '(maj major min minor patch)) + (let ((v (info-version dir))) + (cond + ((or (eq? kind 'maj) + (eq? kind 'major)) + (apply set-info-version! (cons dir + (list (+ (car v) 1) 0 0)))) + ((or (eq? kind 'min) + (eq? kind 'minor)) + (apply set-info-version! (cons dir + (list (car v) (+ (cadr v) 1) 0)))) + (else + (apply set-info-version! (cons dir + (list (car v) (cadr v) + (+ (caddr v) 1))))) + ) + ) + (error "kind must be 'maj, 'major, 'min, 'minor or 'patch") + ) + ) + )