100 lines
3.6 KiB
Racket
100 lines
3.6 KiB
Racket
#lang racket/base
|
|
|
|
(require setup/getinfo
|
|
racket/string
|
|
)
|
|
|
|
(provide info-version
|
|
set-info-version!
|
|
git-next-version
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Read a package version from info.rkt.
|
|
; pre : dir contains a readable info.rkt.
|
|
; post : info.rkt has only been inspected.
|
|
; result : A list containing major, minor and patch.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(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)))))
|
|
))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Store a package version in info.rkt.
|
|
; pre : dir contains info.rkt and version parts are numbers.
|
|
; post : The version definition has been replaced.
|
|
; result : #t after writing the file.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(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)))))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Increment a package version.
|
|
; pre : kind is maj, major, min, minor or patch.
|
|
; post : The version definition in info.rkt has been updated.
|
|
; result : #t after writing the new version.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(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")
|
|
)
|
|
)
|
|
)
|