Version functionality added.

info.rkt

@@ -1,23 +1,23 @@
-#lang info
+#lang info
-
+
-(define collection "git-cli")
+(define collection "git-cli")
-(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
+(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
-(define version "0.3.7")
+(define version "0.3.9")
-(define pkg-authors '("Hans Dijkema"))
+(define pkg-authors '("Hans Dijkema"))
-(define license 'MIT)
+(define license 'MIT)
-
+
-(define deps
+(define deps
-  '("base"
+  '("base"
-    "simple-ini"
+    "simple-ini"
-    "simple-log"
+    "simple-log"
-    "racket-index"
+    "racket-index"
-    "scribble-lib"
+    "scribble-lib"
-    "racket-makefile"
+    "racket-makefile"
-    "package-zipper"))
+    "package-zipper"))
-
+
-(define build-deps
+(define build-deps
-  '("rackunit-lib"
+  '("rackunit-lib"
-    "racket-doc"))
+    "racket-doc"))
-
+
-(define scribblings
+(define scribblings
-  '(("scribblings/git.scrbl" () ("Git"))))
+  '(("scribblings/git.scrbl" () ("Git"))))

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)

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")
+        )
+    )
+  )