Commits

Anonymous committed 5fe4771

implemented functional version of the bumping procedures

  • Participants
  • Parent commits 656d12f

Comments (0)

Files changed (3)

spec/versions.scm

 
 (describe "Sort versions")
 
+
+
 (describe "Bump versions"
   (before each:
-     (set! ($ 'version) (string->version "1.1.1.1")))        
-  (it "can bump major"
+    (set! ($ 'version) (string->version "1.1.1.1")))
+
+
+  (context "Functional"
+
+    (it "can bump major"
+      (let ((v ($ 'version)))
+        (expect (version:major (bump:major v)) (be 2))))
+
+    (it "can bump major to specific version"
+      (let ((v ($ 'version)))
+        (expect (version:major (bump:major v to: 4)) (be 4))))
+
+    (it "can bump minor"
+      (let ((v ($ 'version)))
+        (expect (version:minor (bump:minor v)) (be 2))))
+
+    (it "can bump minor to specific version"
+      (let ((v ($ 'version)))
+        (expect (version:minor (bump:minor v to: 4)) (be 4))))
+    
+    (it "can bump micro"
+      (let ((v ($ 'version)))
+        (expect (version:micro (bump:micro v)) (be 2))))
+
+    (it "can bump micro to specific version"
+      (let ((v ($ 'version)))
+        (expect (version:micro (bump:micro v to: 4)) (be 4))))
+
+    (it "bumps micro if it wasn't set"
+      (let ((v (string->version "1.1")))
+        (expect (version:micro (bump:micro v)) (be 1))))
+
+
+    (it "bumps patch"
+      (let ((v (string->version "1.2.3.4.5")))
+        (expect (version:patch (bump:patch v)) (be (list 4 6)))))
+    (it "bumps patch if not set"
+      (let ((v (string->version "1.2.3")))
+        (expect (version:patch (bump:patch v)) (be (list 1)))))
+
+    (it "bumps patch to specfic version"
+      (let ((v (string->version "1.2.3")))
+        (expect (version:patch (bump:patch v to: (list 1 2))) (be (list 1 2)))))
+
+
+    (it "bumps patch if present"
+      (let ((v (string->version "1.2.3.1")))
+        (expect (version->string (bump v)) (be "1.2.3.2"))))
+
+    (it "bumps micro if present"
+      (let ((v (string->version "1.2.3")))
+        (expect (version->string (bump v)) (be "1.2.4"))))
+
+    (it "bumps minor if present"
+      (let ((v (string->version "1.2")))
+        (expect (version->string (bump v)) (be "1.3"))))
+
+    )
+  
+  (context "Side-effecting"
+    
+    (it "can bump major"
       (let ((v ($ 'version)))
         (expect (version:major (bump:major! v)) (be 2))))
 
-  (it "can bump major to specific version"
+    (it "can bump major to specific version"
       (let ((v ($ 'version)))
         (expect (version:major (bump:major! v to: 4)) (be 4))))
 
-  (it "can bump minor"
+    (it "can bump minor"
       (let ((v ($ 'version)))
         (expect (version:minor (bump:minor! v)) (be 2))))
 
-  (it "can bump minor to specific version"
+    (it "can bump minor to specific version"
       (let ((v ($ 'version)))
         (expect (version:minor (bump:minor! v to: 4)) (be 4))))
-  
-  (it "can bump micro"
+    
+    (it "can bump micro"
       (let ((v ($ 'version)))
         (expect (version:micro (bump:micro! v)) (be 2))))
 
-  (it "can bump micro to specific version"
+    (it "can bump micro to specific version"
       (let ((v ($ 'version)))
         (expect (version:micro (bump:micro! v to: 4)) (be 4))))
 
-  (it "bumps micro if it wasn't set"
+    (it "bumps micro if it wasn't set"
       (let ((v (string->version "1.1")))
         (expect (version:micro (bump:micro! v)) (be 1))))
 
 
-  (it "bumps patch"
+    (it "bumps patch"
       (let ((v (string->version "1.2.3.4.5")))
         (expect (version:patch (bump:patch! v)) (be (list 4 6)))))
-  (it "bumps patch if not set"
+    (it "bumps patch if not set"
       (let ((v (string->version "1.2.3")))
         (expect (version:patch (bump:patch! v)) (be (list 1)))))
 
-  (it "bumps patch to specfic version"
+    (it "bumps patch to specfic version"
       (let ((v (string->version "1.2.3")))
         (expect (version:patch (bump:patch! v to: (list 1 2))) (be (list 1 2)))))
 
 
-  (it "bumps patch if present"
+    (it "bumps patch if present"
       (let ((v (string->version "1.2.3.1")))
         (expect (version->string (bump! v)) (be "1.2.3.2"))))
 
-  (it "bumps micro if present"
+    (it "bumps micro if present"
       (let ((v (string->version "1.2.3")))
         (expect (version->string (bump! v)) (be "1.2.4"))))
 
-  (it "bumps minor if present"
+    (it "bumps minor if present"
       (let ((v (string->version "1.2")))
-        (expect (version->string (bump! v)) (be "1.3"))))
+        (expect (version->string (bump! v)) (be "1.3")))))
 
 
   )
-(use missbehave)
+(use missbehave missbehave-matchers missbehave-stubs)
 (exit (behave (lambda () (include "../spec/versions.scm"))))
 
  version-older?
  version-exact?
  version-sort
+ update-version
+ bump:major
+ bump:minor
+ bump:micro
+ bump:patch
+ bump
  bump:major!
  bump:minor!
  bump:micro!
 (import chicken scheme)
 (require-library srfi-1 srfi-13)
 (import srfi-1 srfi-13 data-structures)
+(import (only extras fprintf))
 
 
 ;;; version type
     (patch    version:patch version:patch-set!)
     (extra    version:extra))
 
-
+(define-record-printer (version v out)
+  (fprintf out "#<version ~A>" (version->string v)))
 
 ;;; conversion methods
 
 ;; (make-version major minor #!key label micro patch extra)
 ;; creates a version object with most fields optional
 (define (make-version maj mnr #!key (label #f) (micro #f) (patch #f) (extra #f))
-    (##sys#check-exact maj 'make-version)
-    (##sys#check-exact mnr 'make-version)
-    (##ver#check-exact micro 'make-version)
-    (##ver#check-string label 'make-version)
-    (##ver#check-string extra 'make-version)
-    (and patch
-         (cond ((list? patch)
-                   (if (null? patch)
-                       (set! patch #f)
-                       (every (cut ##ver#test-exact <> 'make-version) patch)))
-               ((vector? patch)
-                   (set! patch (vector->list patch))
-                   (if (null? patch)
-                       (set! patch #f)
-                       (every (cut ##ver#test-exact <> 'make-version) patch)))
-               ((##ver#test-exact patch 'make-version)
-                   (set! patch (list patch)))
-               (else
-                   (##sys#signal-hook #:type-error 'make-version
-                                      "argument is not a list, exact, or #f"
-                                      patch))))
-    (version-new label maj mnr micro patch extra))
+  (##sys#check-exact maj 'make-version)
+  (##sys#check-exact mnr 'make-version)
+  (##ver#check-exact micro 'make-version)
+  (##ver#check-string label 'make-version)
+  (##ver#check-string extra 'make-version)
+  
+  (and patch
+       (cond ((list? patch)
+              (if (null? patch)
+                  (set! patch #f)
+                  (every (cut ##ver#test-exact <> 'make-version) patch)))
+             ((vector? patch)
+              (set! patch (vector->list patch))
+              (if (null? patch)
+                  (set! patch #f)
+                  (every (cut ##ver#test-exact <> 'make-version) patch)))
+             ((##ver#test-exact patch 'make-version)
+              (set! patch (list patch)))
+             (else
+              (##sys#signal-hook #:type-error 'make-version
+                                 "argument is not a list, exact, or #f"
+                                 patch))))
+  
+  (version-new label maj mnr micro patch extra))
 
 
 
                 ##ver#sort-dec))))
 
 
-;; Bumping procedures
+;; Bumping interface
 
-(define ((make-version-bumper getter setter loc) version #!key (to #f))
+;; functional interface
+(define (update-version version #!key (major #f) (minor #f) (micro #f) (patch #f))
+  (make-version
+   (or major (version:major version))
+   (or minor (version:minor version))
+   label: (version:label version)
+   micro: (or micro (version:micro version))
+   patch: (or patch (version:patch version))
+   extra: (version:extra version)))
+
+(define ((make-version-bumber field getter loc) version #!key (to #f))
+  (let* ((version (##ver#check-version version loc))
+         (value   (getter version))
+         (new-value (if to to (if value (+ 1 value) 1))))
+    (update-version version field new-value)))
+
+(define bump:major (make-version-bumber major: version:major 'bump:major))
+(define bump:minor (make-version-bumber minor: version:minor 'bump:minor))
+(define bump:micro (make-version-bumber micro: version:micro 'bump:micro))
+
+(define (bump:patch version #!key (to #f))
+  (let* ((version (##ver#check-version version 'bump:patch))
+         (patch (version:patch version)))
+    (cond
+     (to
+      (update-version version patch: to))
+     ((list? patch)
+      (let* ((last-version (last patch))
+             (new-version (reverse (cons (+ 1  last-version) (cdr (reverse patch))))))
+        (update-version version patch: new-version)))
+     (else
+      (update-version version patch: (list 1))))))
+
+(define (bump version)
+  (let ((version (##ver#check-version version 'bump)))
+    (cond
+     ((version:patch version) (bump:patch version))
+     ((version:micro version) (bump:micro version))
+     ((version:minor version) (bump:minor version)))))
+
+;; side-efecting interface
+(define ((make-version-bumper! getter setter loc) version #!key (to #f))
   (let* ((version (##ver#check-version version loc))
          (value (getter version))
          (new-value (if to to (if value (+ 1 value) 1))))
     (setter version new-value)
     version))
 
-(define bump:major! (make-version-bumper version:major version:major-set! 'bump:major!))
-(define bump:minor! (make-version-bumper version:minor version:minor-set! 'bump:minor!))
-(define bump:micro! (make-version-bumper version:micro version:micro-set! 'bump:micro!))
+(define bump:major! (make-version-bumper! version:major version:major-set! 'bump:major!))
+(define bump:minor! (make-version-bumper! version:minor version:minor-set! 'bump:minor!))
+(define bump:micro! (make-version-bumper! version:micro version:micro-set! 'bump:micro!))
 
 (define (bump:patch! version #!key (to #f))
   (let* ((version (##ver#check-version version 'bump:patch!))